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Abstract 


This  report  describes  several  IBM  370/158  computer  programs 
that  have  been  applied  to  long-period  seismic  data  on  digital 
tapes.  Included  are  reading  routines  for  tapes  generated  by  the 
high-galn  long-period  (HGLP)  stations,  rotation  of  the  horizontal 
components,  low-,  band-  and  high-pass  digital  filters,  correlation 
(or  matched  filtering),  summation  of  correlations,  beam  focusing, 
and  ground  motion  retrieval. 

/ 

Results  of  applications,  described  elsewhere  or  in  prepara- 
tion, Include  extraction  and  amplitude  determination  of  Rayleigh 
waves  with  signal-to-noise  ratios  near  1 to  10,  precision 
amplitude  and  phase  calibration  of  entire  seismic  systems  from 
transducer  to  final  record,  beam  forming  of  matched  filtered 
outputs  from  the  randomly  spaced  HGLP  station  array,  and  separa- 
tion of  colocated  multiple  events  with  time  spacing  as  short  as 
150  sec  or  separation  of  events  widely  spaced  geographically  but 
arriving  nearly  simultaneously  at  a given  station. 
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Introduction 


The  system  o£  programs  and  subroutines  described  here 
has  evolved  over  a number  of  years  of  research  using  digital 
data  tapes  from  High-Gain  Long-Period  Seismic  stations  in 
studies  of  seismic  surface  waves.  A prototype  was  described 
by  Pomeroy  ^t  a_l.  (1969),  and  operational  systems  have  been 
documented  in  detail  in  a Lamont -Doherty  Geological  Observa- 
tory report  (1971).  E.  Berg,  principal  investigator  on  the 
project,  set  the  goals,  elaborated  most  of  the  mathematics, 
and  checked  and  interpreted  the  results;  D.  Chesley  performed 
almost  all  of  the  programming.  The  results  presented  here  were 
accomplished  through  close  daily  interaction  between  program- 
ming and  verification  of  the  outputs.  Since  several  Hawaii 
Institute  of  Geophysics  (HIG)  staff  members  contributed  to 
the  effort,  the  programmer's  name  for  each  subroutine  has 
been  listed  under  'source'  in  the  program  descriptions. 

Published  applications  of  the  programs  to  detection  and 
amplitude  determination  of  extremely  weak  Rayleigh  waves 
(Berg,  1974,  1975)  include  examples  of  both  the  type  of  output 

obtainable  from  the  programs,  and  the  mathematics  involved. 

An  additional  application  is  in  obtaining  the  automated  ampli- 
tude and  phase  response  of  a complete  s e i smome t e r - r ec or d ing 
system  from  step  inputs  to  the  calibration  coil  (or  similar 
calibration  devices),  where  high  accuracy  is  achieved  by 
summing  into  an  operating  system  as  many  individual  pulses  as 
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desired  (to  eliminate  the  ever-present  background  noise) 
by  the  use  of  correlation  and  subsequent  Fourier  analysis. 

The  only  parameters  required  are  the  seismometer  mass,  the 
calibration  coil  constant  (referred  to  the  center  of  mass 
if  appropriate)  and  current,  and  the  precise  onset  time  of  one 
reference  calibration  current.  This  work  (Berg  and  Chesley, 
in  press)  is  especially  applicable  to  large  arrays  and  remote- 
control  systems  with  complicated  transmission  interfaces  to 
the  recording  site.  Other  applications  to  geophysical  data 
come  readily  to  mind,  but  will  not  be  discussed  here. 

Most  of  the  routines  are  written  in  FORTRAN  and  are  meant 
for  use  on  the  IBM  370/158  computer.  The  programs  accomplish 
all  data  handling,  from  reading  the  tape  to  plotting  and  tabu- 
lating the  results  of  various  manipulations. 

The  programmer  intended  that  the  programs  and  subroutines 
should  interact  with  a minimum  of  input  from  the  user.  Thus  a 
typical  main  program  supplied  by  the  user  will  consist  of  a 
few  initialization  statements  followed  by  CALL  statements  that 
refer  to  the  subroutines,  where  all  of  the  analysis  is  performed. 
If  a user  wishes  to  extract  Information  from  his  tapes  using 
one  of  the  subroutines  listed  in  this  report,  he  needs  only 
to  copy  the  appropriate  sample  program  from  the  report;  or 
he  may  generate  his  own  program  to  access  the  subroutines 
according  to  his  specific  needs. 

The  reader  is  cautioned  against  modifying  the  subroutines. 
Their  interaction  is  quite  complex,  and  a seemingly  inocuous 


\ 
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change  in  one  routine  could  require  extensive  modifications  in 
other  subprograms. 

Most  of  the  programs  are  designed  for  analysis  of  seismic 
velocity  output  (A-channel)  data;  exceptions  are  FINDB  and 
PLOTB.  The  A-channel  format  is  1 data  point  per  second,  555 
seconds  per  record,  on  5 56  - b i t - p e r - i n c h magnetic  tape,  and 
the  B channels  are  digitized  at  1 data  point  per  5 seconds  and 
111  data  points  per  record.  The  header  of  each  record  gives 
start  time,  station  number,  number  of  A channels  (3)  , number 
of  B channels  (3) , and  digitizing  interval  for  A channels  (1 
second).  It  is  emphasized  that  modifications  allowing  use  of 
B channels  for  correlation  and  other  complicated  numerical 
manipulations,  would  be  difficult.  At  present  the  B channels 
may  be  read  from  the  tape  at  any  interval  (1  data  pt/5  sec, 

1 pt/min,  1 pt/hr,  and  so  on)  and  plotted  on  any  scale.  The 
filters  may  also  be  applied  directly  with  the  appropriate 
value  of  DLT . 

Finally,  this  report  will  not  describe  the  mathematical 
justifications  for  the  procedures  used,  since  they  have  been 
provided  elsewhere  (Berg,  1974,  1975). 


SYSTEM  STRUCTURE 


This  section  discusses  Che  Interactions  that  accomplish 
data  transfer  between  subroutines. 

RREAD  , a routine  written  in  ASSEMBLOR  , reads  data  from 
the  tape,  555  seconds'  worth  (1  record,  6006  bytes)  at  a time. 
The  data  pass  to  READ  through  the  array  AREA.  READ  interprets 
the  data,  forming  for  each  record  a header  array  and  six  data 
arrays.  The  header  array,  HEAD  (10)  , consists  of  (1)  record 
number,  (2)  station  number  (22  = KIP),  (3)  year,  (A)  day, 

(5)  hour,  (6)  minute,  and  (7)  second  of  the  start  time  of  the 
data  in  the  record,  (8)  number  of  A (velocity)  channels, 

(9)  number  of  B (displacement)  channels,  and  finally  (10)  spac- 
ing in  seconds  between  data  points  in  the  A channels.  HEAD 
(7)  and  HEAD  (10)  are  not  integers,  so  the  use  of  the 
EQUIVALENCE  (HEAD  (1),  I EAD  (1))  statement  is  helpful. 

Beginning  with  the  first  records,  FIND  checks  the  times 
in  HEAD  (3-7)  against  the  desired  start  time  until  it  finds  the 
correct  starting  record.  FIND  calculates  the  correct  record 
number  by  subtracting  the  time  in  HEAD  (3-7)  from  the  desired 
start  time,  dividing  the  result  by  555 s e c / r e c or d and  skipping 
backward  or  forward  by  the  correct  number  of  records,  repeating 
this  process  until  it  reaches  the  record  containing  the  desired 
start  time.  This  procedure  reduces  execution  time  but  becomes 
unworkable  if  there  is  a large  gap  in  the  data.  Refer  to  the 
description  of  READ  for  details. 


FIND  takes  records  one  by  one  from  RF.AD  through  Al-3 
in  COMMON / SMACK / and  loads  the  data  into  CHI-3.  At  the  end 
of  the  FIND  subroutine,  SHRINK  corrects  CHI-3  by  deleting  data 
from  the  beginning  and  end  of  each  channel  that  are  outside 
the  desired  time  range.  CHl-3  are  then  of  equal  length  and 
contain  vertical,  NS,  and  EW  velocity  data,  respectively. 

HEAD  (3-7)  contains  the  time  of  the  first  data  point,  and  IXMAX 
(COMMON/X/)  contains  the  length  of  each  array.  At  this  point, 
FIND  returns  control  to  the  main  program.  The  data  in  CHl-3 
must  be  despiked  by  the  statement  CALL  DSPYK(O),  after  which 
they  are  ready  for  any  of  the  manipulations  described  below. 

ROTATION--This  calculation  translates  NS  and  EW  data 
into  radial  (parallel  to  propagation  direction)  and  transverse 
(perpendicular  to  radial),  modes  (both  in  plane  of  surface). 
Data  in  CHI,  CH2,  and  CH3  are  not  changed  in  any  way.  Instead, 
two  new  arrays  (CHR  and  CHT,  radial  and  transverse)  are  filled. 
The  parameters  required  by  the  subroutine  ROTATE  are  PHI,  the 
azimuthal  angle  (N  through  E)  between  N and  the  direction  of 
the  earthquake  epicenter  from  the  receiving  station  (measured 
in  degrees) , and  G,  the  gain  of  channel  A3  relative  to  channel 
A2  (F.W  relative  to  NS). 

FILTERING--  Three  zero-phase  shift  filters  are  available 
in  this  system:  high-pass,  low-pass,  and  band-pass,  where  high 
and  low  refer  to  frequency.  The  user  calls  HPFILT,  LPFILT,  and 
BPFILT  to  calculate  the  filter  coefficients,  which  he  places 
in  the  array  W whose  length  is  2*N+1.  The  user  supplies  HAMING, 
which  truncates  the  filters  with  a Hamming  window  by  changing 
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the  contents  of  W;  «nd  the  user  supplies  N to  FLTADJ  so  that  start 
and  stop  times  supplied  to  FIND  can  be  modified.  DOFILT  per- 
forms the  filtering  on  one  channel  at  a time  and  changes  the 
contents  of  CHI-3,  CHR,  or  CHT.  The  filtering  is  done  in  the 
time  domain  by  a correlation  technique  between  array  W and 
a data  channel  the  user  specifies.  This  technique  deletes  N 
points  from  each  end  of  the  filtered  array.  DOFILT  changes 
the  start  time  in  HEAD  (1-10)  and  the  value  of  IXMAX  (if  1CHG 
= 1)  so  that  the  correct  values  of  HEAD  (10)  and  IXMAX  pass  to 
subsequent  programs.  ICHG  should  be  set  to  1 on  the  final 
call  to  DOFILT. 

In  addition  to  calculating  filter  coefficients,  HPFILT, 

BPFILT,  and  LPFILT  supply  through  COMMON/FILT/  a string  and 
periods  (in  seconds)  to  the  plotting  subroutine  (PLT1).  PLT1 
uses  for  these  values  the  labels  of  the  plot. 

FOURIER  ANALYSIS--If  the  user  copies  the  data  in  any  of  the 
channel  arrays  (CHl-3,  CHR,  CHT)  into  a complex  array  whose 
Imaginary  part  is  zero  and  whose  length  is  an  integral  power 
of  2,  FASTO  (Fast  Fourier  Transforn)  may  be  used.  It  replaces 
the  data  in  the  array  with  the  complex  Fourier  coefficients. 

The  resulting  array  is  symmetric  about  data  point  N+ 1 (Nyquist 
frequency).  The  second  half  of  the  array  will  be  the  complex 
conjugate  of  the  first.  The  first  data  point  of  the  array  will 
contain  the  mean.  AVENUL  may  be  used  to  zero-mean  the  data 
prior  to  loading  the  complex  array. 

PLOTTING--PLT1  is  designed  to  plot  a single  channel  seis- 
mogram on  a XYNETICS  plotter.  This  subroutine  draws  the  seismogram. 
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labels  the  axes,  and  writes  a title  underneath  the  plot.  The 
title  includes  station  number  and  three-letter  abbreviation, 
and  the  time  of  the  first  data  point,  all  from  HEAD  (1-10). 

With  appropriate  arguments,  PLT1  labels  the  rotation  angle  and 
gain  factor  (from  COMMON / ANGLE /)  , as  well  as  the  filter  type  and 
corner  periods  (from  COMMON / FI LT/ ) . SETXYN  or  SETCC  supply  letter 

size  (HI,  H2)  and  distance  (XOFF,  YOFF)  from  the  starting  pen 
position  to  the  origin  of  the  plot  (bottom  end  of  Y-axis)  through 
COMMON /Pl.TPAR  / . A f t e r one  seismogram  is  plotted  (one  XYNETICS 
drawing  is  generated)  PLT1  places  the  pen  above  and  to  the  left 
of  tlie  plot.  A subsequent  call  to  PLT1  will  generate  a second 
trace  immediately  above  the  first  (if  the  operator  has  not 
moved  the  pen  manually).  Thus  plots  are  generated  from  the 
bottom  upward.  To  receive  the  plots  in  the  usual  order,  the 
user  must  plot  CH3  first  and  CHI  last. 

PLl’l  rails  XYNETICS  subroutines,  which  are  similar  to 
some  ('. AI.COM P plotting  routines.  An  output  tape  is  required  and 
each  job  generates  one  file  on  the  tape.  DTRK  must  be  specified 
in  the  J CL  for  this  output  tape  even  though  800  BPI  is  used. 

Please  read  the  XYNETICS  plotting  instruction  booklet  for  more 
details  (XYNETICS,  1973). 

PI.T1  can  find  the  maximum  and  minimum  values  in  the  array 
to  be  plotted,  thus  making  the  plot  (without  labels)  exactly 
the  height  specified.  PLT1  prints  the  values  it  has  used.  If 
the  station  number,  HEAD(2),  is  not  in  PLTl's  list,  it  prints 
this  number  and  deletes  the  station  name  and  number  from  the 
label.  PLTl  can  be  used  to  plot  any  array,  but  the  horizontal 
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axis  is  labelled  correctly  only  If  the  data  points  are  one 
second  apart  and  the  correct  start  time  has  been  previously 
placed  in  HEAD  (3-7) . PLTB  may  be  used  if  the  data  points 
are  an  integer  multiple  of  5 sec  interval. 

A printer  plot  of  any  array  may  be  generated  by  PRPLT1. 
There  are  no  labels,  except  that  each  line  contains  the  data 
point  number  and  its  value.  One  line  per  array  element  is 
printed. 

The  procedures  above  apply  to  A-channel  (velocity)  informa- 
tion. If  the  user  wishes  to  read  B-channel  (displacement)  data, 
he  must  use  FINDB.  Here  he  has  the  option  of  specifying  the 
spacing  in  seconds  between  successive  data  points  in  his  final 
CHl-3  arrays.  Rotation  and  filtering  may  be  applied  directly. 

P LOT B should  be  used. 

CORRELATI ON- -Oros s - cor r e 1 a t ion  is  accomplished  by  using 
several  subroutines.  A short  seismogram  segment  (<20  min) 
called  the  reference  is  correlated  with  a longer  segment  (<45 
min)  called  the  scan.  Much  information  may  be  extracted  from 
this  process,  but  only  programming  considerations  will  be 
discussed  here. 

The  user  supplies  start  and  stop  times  for  the  reference 
and  the  scan,  as  well  as  an  origin  time  for  the  earthquake  re- 
presented in  the  reference,  through  a BLOCK  DATA  subprogram. 

He  must  also  calculate  any  filter  before  calling  COREAD.  COREAD 
then  reads  scan  and  reference  from  the  input  tape,  rotates  and/ 
or  filters  the  data  if  desired,  and  stores  the  results  in 
scratch  files  on  the  disk.  Note  that  if  COREAD  is  to  be  used. 
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FLTADJ , D0F1LT,  and  ROTATE  should  not  be  called  in  the  main 
program.  The  start  and  stop  times  should  be  those  the  user 
wishes  to  see  in  the  final  output  plots.  COREAD  performs  all 
the  manipulations  of  times  that  are  necessitated  by  time 
domain  correlations. 

The  user  then  calls  C0RRL8,  once  for  each  channel.  Each 
call  to  C0RRL8  reads  the  data  from  the  appropriate  scratch 
file  and  plots  the  reference  and  then  the  scan.  C0RRL8  per- 
forms the  correlation  and  plots  the  coefficients.  C0RRL8 
places  the  output  parameters  of  interest  in  COMMON/PRINT/  for 
later  listing  by  TABLE.  Finally,  it  calculates  the  sum  trace. 
This  array  (SUM)  contains  the  po in t -by-po int  arithmetic  mean 
of  all  the  correlation  coefficients  produced  by  C0RRL8.  For 
example,  if  three  channels  are  correlated,  each  call  to  C0RRL8 
adds  to  the  values  already  in  SUM  the  coefficients  calculated 
by  C0RRL8,  but  divided  by  three.  After  the  user  calls  C0RRL8 
three  times,  SUM  will  contain  the  average  of  three  correlations. 
COREAD  initializes  SUM  to  zero.  Because  of  the  nature  of  PLT1, 
CH3  should  be  correlated  first  and  CHI  last. 

After  correlation,  a single  CALL  PLT1  plots  the  sum  trace 
and  all  the  timing  information  is  correct.  CALL  TABLE  tabulates 
the  results  for  all  channels  and  CALL  WRTSUM  writes  the  sum  trace 
coefficients  on  disk  for  later  use  in  beam  focusing.  At  the  end 
of  all  plotting  jobs  the  statement 

CALL  PLOT  (0,  HYT,  999) 

should  be  used.  This  places  an  EOF  on  the  output  tape  and 


10 


generates  a table  showing  how  many  XYNETICS  drawings  have  been 
produced  (1  for  every  CALL  PLT1  plus  an  extra  for  the  EOF), 
thus  checking  the  correct  operation  of  the  program. 

BEAM  FOCUSING--A  further  Increase  In  the  s 1 gn a 1 - t o- no  1 s e 
ratio  for  correlation  SUM  traces  may  be  accomplished  by  avera-  i 

glng  several  SUM  traces  that  were  created  by  calls  to  WRTSUM. 

This  procedure  Is  accomplished  by  the  program  SUMAVE,  listed 
In  the  following  section. 

GROUND  MOTION'-Use  of  the  subroutine  INFILT  with  the 
other  filtering  subroutines  (FLTADJ,  DOFILT)  allows  retrieval 
of  the  ground  motion  by  deconvolution  of  the  seismometer  and 
recording  system  response  from  the  taped  seismic  data.  The 
response  must  be  stored  on  disk.  The  sample  program  FILTER1 

j 

illustrates  this  procedure. 

I 


t 


I 


•n.i-  ,j.' 
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SUBROUTINES 

This  section  contslns  lists  of  all  the  subroutines  In 
the  system.  There  are  four  types  of  subroutines: 

FILTER:  These  subroutines  calculate  filter  coefficients 


and  start  times,  and  are  used  to  apply  the  various 
filters  to  the  data.  Filtering  Is  accomplished 
using  a correlation  technique  and  requires 
several  routines. 


UTILITY:  These  subroutines  perform  'bookkeeping'.  They 

usually  are  short  and  usually  are  not  found  In 
main  programs . 

INPUT-OUTPUT  (10):  These  read  tapes,  plot,  write  files, 

or  print  results. 

DATA:  These  programs  perform  the  mathematical  manipula- 

tions, except  for  filtering. 

The  following  list  should  be  useful  for  finding  the  exact 
order  of  the  arguments  of  the  subroutines. 
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AVENUL  (A,  I) 

BPF1LT  (W,  N,  DLT , BPFREQ  , HPFREQ) 

COREAD  (LREF  , PHI,  GA) 

CORRL8  (ICHAN,  SCALE,  HYT,  LAB,  NUMCH) 

DOFILT  (A,  W,  N,  ICHG) 

DSPYK  (NUM) 

FASTO  (A,  M,  MODE) 

FIND  (ISTART,  ISTOP) 

FINDB  (ISTART,  ISTOP,  INTER) 

FLTADJ  (IL,  ISRT  , ISTP) 

HAMING  (W,  N) 

HDCONV  ( IHEAD , NUM) 

HD2SEC  (IA,  IB) 

HP  F I LT  (W,  N,  DLT,  HPFREQ) 

INFILT  (ICH,  W,  N,  Nl,  N2) 

KREAO  (AREA,  NBYTES)  or  KRDBK  (AREA (LAST) , NBYTES) 
LPFILT  (W,  N,  DLT,  BPFREQ) 

MAXMIN  (A,  N,  AMAX,  MAXJ  , AMIN,  MINJ) 

PLOTB  (Z,  SCALE,  HITE,  ZMAX  , ZMIN  , LKZ  , ISPIK,  LAB, 
PLT 1 (Z,  SCALE,  HITE,  ZMAX,  ZMIN,  LKZ,  ISPIK,  LAB) 

PRPLT1  (X,  LB,  LE,  LS) 

READ  (NREC,  I PRT ) 

ROTATE  (PHI,  G,  NUM) 

SEC2HD  (IB,  IA) 

SETCC 


INTER) 


SETNP 
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SETXYN 

SHRINK  (IBEG,  1END) 
TABLE 

WRTSUM  (IF) 


i 
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NAME  - - AV  ENU  L 
TYPE  - -DATA 

SOURCE--MAREK  FRYDR1CH 

PURPOSE  and  COMMENTS -- sub t r ac t 8 the  mean  from  an  array  of  data 

DESCRIPTION  - -CALL  AVENUL  (A,  I) 

where:  A is  the  name  of  the  array 

I is  the  length  of  the  array. 


ISN  0002 
ISN  0003 
ISN  0004 
ISN  0005 
ISN  0006 
I SN  0007 
ISN  0000 
ISN  0000 
ISN  0010 
ISN  0011 
ISN  0012 


SUBROUTINE  A VENUL < A . I XMAX 1 
0 l ME  NS  1 ON  All) 

SUN=0.0 

DC  S 1*1, l XM AX 
SUM=  SUM* At  l ) 

5 CONT  INUE 

DU  7 I al , I XMAX 

A(  J )=A(  I )-{ SUM/ IX  MAX  ) 

7 CONTINUE 
RETURN 

End 


1 
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NAME- -BPF1LT 
TYPE- -F 1LTER 
SOURCE--D.  CHESLEY 


PURPOSE - -Gene r a t es  filter  coefficients  for  a band-pass  filter. 
The  filter  will  be  applied  by  a correlation  technique 
(D0F1LT)  in  the  time  domain. 

DESCRIPTION --CALL  BPFILT  (W , N,  DLT , BPFREQ , HPFREQ) 
where  W - the  array  for  the  coefficients 

N - the  number  such  that  2*N+1  is  the  number  of 
coefficients  (SlOOO) 

DLT  - the  time  Interval  between  data  points  In  seconds 
BPFREQ  - low  pass  corner  frequency  (HZ) 

HPFREQ  - high  pass  corner  frequency  (HZ) 

This  program  must  be  used  In  conjunction  with  FLTADJ , D0F1LT, 
and  HAMING. 


I 


» 


COMMON-- /FI LT  / Is  used  by  PLT1  for  correct  labelling  of  the  plot. 


I Sn  o 002 


C 

C 

c 

c 


SCO  R OUT  I NE  BPFILT  (W ,N, 01 f . BPFRF Q.  HPf RFQ  I 

W IS  ARRAY  of  2*NM  points 

N IS  NUMBER  OF  DATA  POINTS  EACH  SIDF  OP  MIDDLE 


I SN 

0 00  3 

COMMON/F IlT/FILAB(ZI. 

I SN 

0 004 

PI  ME  NS  I ON  XL  AP<  2 ) 

t On 

0 005 

D I ME  NS  I ON  Will 

l SN 

0 00  6 

DATA  XL  Afi/  • BP  F • , ML  T 

I jN 

000? 

SPER  -1  ,/HPFRE  0 

I SN 

0 OOP 

XL  PE  R=l.  X BPFREQ 

I 2n 

0 00<) 

F I L A B(  1 )a  xl  A6  ( l 1 

I SN 

0 010 

FI  LAP (2 1 aXLABI 2 1 

I SN 

ooii 

P 1=3*141  592  6536 

I SN 

0 01  2 

CONI  = OLT*UPFREQ*2  . 

I SN 

0 013 

CON2  =OL  T * HPF  RE Q*2  . 

1 SN 

001  A 

DO  10  I =1  .N 

I SN 

0 015 

XI  = C -N+  1 -1  l*P I * C 0 N 1 

I SN 

0 Cl  fc 

X?  =(  -Nt 1 '1  ) *P I *C ON2 

I SN 

0 01  7 

w(  l ) = C ON  1 *StN (Xll/Xl- 

I ?N 

001  s 

W ( 2*  N-  I 4 2 ) =W  ( I 1 

I SN 

0 Cl  9 

10  CONTINUE 

! SN 

o o2o 

M ( N+  1 >=C0Nl  -CCN2 

I SN 

0021 

RE  TURN 

I SN 

0 022 

E NO 

CON?*S !N< X21  /X2 


PRiiC^DING  PASS  BLANK..  iOT  FILMS? 
V ' "laT>~.  * * 


-*•  V 
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NAME  - - COREAD 
TYPE  - - 10 

SOURCE  - -D  . CHESLEY 

PU RPOSE -- COREAD  reads  data  from  tape  and  creates  scratch  files 
for  subsequent  access  by  C0RRL8. 

DESCRIPT10N--CALL  COREAD  (LREF , PHI,  GA) 

LREF  - If  LREF  ^ 0 the  program  applies  a filter  to  all  data  . 

PHI  - angle  of  rotation 
GA  - gain  factor  for  rotation 

PHI  and  GA  are  the  arguments  of  ROTATE.  If  they  are  both  zero 
no  rotation  is  performed. 


COMMON -- /S EARCH / - contains  data  that  is  read  off  tape 

/COR/  - contains  array  for  sum  (average  correlation) 

trace  and  times  for  reference,  origin,  and  scan 
/TIME/  - contains  lengths  of  various  arrays,  start 

times  of  reference  and  scan,  and  JUMP,  which 
indicates  the  order  of  the  reference  and  scan 
in  time 

/ANGLE/  - contains  data  for  PLT  labels 
/TURN/  • contains  rotated  data 
/ARRAY/  - contains  filter  length  and  coefficients 
/PRINT/  - contains  data  for  TABLE  that  are  initialized 


in  COREAD 
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NOTES - -CORRL8  operates  on  only  one  channel  at  a time.  To 

avoid  rereading  the  tape  for  other  channels,  COREAD  reads 
the  data  once  and  creates  scratch  files,  which  are  then 
read  by  C0RRL8.  This  saves  execution  time  and  core 
requirements  but  adds  three  more  cards  to  the  JCL  stream. 
Suitable  modifications  to  COREAD  enable  the  user  to  use 
other  types  of  reference  and  scan  data.  Files  may  be 
created  by  an  independent  main  program  and  suitable  para- 
meters supplied  to  C0RRL8  through  COMMON.  Similar  modifi- 
cations have  been  used  to  allow  an  average  calibration 
pulse  as  a reference  instead  of  actual  data  read  from 
magnetic  tape  by  COREAD.  The  danger  in  modifications 
such  as  these  is  that  values  in  COMMON  areas  may  be 
wrong  (such  as  start  times  or  array  sizes);  these  values 
should  be  carefully  examined  in  the  event  of  a program 
failure.  The  necessary  times  are  supplied  to  OOREAD  from 
a BLOCK  DATA  subprogram  through  COMMON/COR/.  IREFl  and 
IREF2  (dimension  = 5,  integer)  contain  year,  day,  hour, 
minute,  and  second  of  the  start  and  stop  times  of  the 
reference  to  be  read  off  tape  and  used  by  PLT1  labels. 
IORIG  contains  the  origin  time  of  the  reference  earth- 
quake in  the  same  format.  ISCANl  and  ISCAN2  contain 
start  and  stop  times  for  the  scan  trace. 

The  user  must  supply  the  JCL  for  defining  the  scratch 
files.  See  sample  programs. 
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l SN 

0C02 

1 SN 

0 C 0 3 

I SN 

00  0 4 

1 SN 

0005 

I SN 

OC  06 

I SN 

0 C 0 7 

I SN 

OCOP 

I SN 

0009 

C 

I 3 N 

001  0 

I SN 

0011 

I SN 

0012 

C 

I SN 

0013 

I SN 

001  4 

20 

I SN 

001  5 

I SN 

0016 

I SN 

001  7 

I SN 

00  1 B 

I SN 

OC  1 9 

I SN 

OC  20 

I SN 

0021 

I SN 

0022 

I SN 

0023 

1 oN 

0024 

I SN 

0025 

I SN 

OC  2 6 

I SN 

0027 

I SN 

0 0 2 P 

I SN 

0029 

I SN 

0030 

I SN 

0031 

50 

C 

I SN 

OC  32 

I SN 

0033 

I SN 

00  34 

I SN 

0035 

ISN 

0036 

I SN 

0037 

70 

1 SN 

003e 

C 

I SN 

004C 

71 

I SN 

004  1 

ISN 

0042 

I SN 

0043 

72 

I SN 

00  44 

I SN 

004b 

I SN 

0 04  6 

I SN 

0047 

I SN 

0049 

I SN 

0050 

I SN 

0051 

C 

I SN 

0052 

00 

I SN 

0053 

I SN 

0054 

_ £- 

I SN 

0055 

90 

I SN 

0056 

I SN 

0057 

r sn 

OC  5 P 

I SN 

0060 

l SN 

0061 

I SN 

0062 

10 

ISN 

0063 

I SN 

0064 

100 

I SN 

0C65 

l SN 

0066 

1 SN 

0067 

I SN 

0068 

I SN 

0070 

I SN 

0072 

- - .. 

SURROUT INF  CORFAC(LREF,PHI,GA) 

COMMON/ SEARCH/CHl  (5550)  . C M2 ( 555 O ) , C H3  ( 55 50  ) 

Cl  MM  OH /COR/  SOM  I 270  0 > • l REF  1(  5 ) . I REF  2(0)  . I OR  I G(  5)  « 

I SC  ANi  (T).!  SC  AN?  ( 5 ) 

COMMON/ T I MS / NS EC, REF SEC. RF ST RT .SCNSRT  .JUMP. ENOS EC 

r I.MMf.M/  ANGLE/  ang,  gain 
C l.  MMON/  TURN/CHR  (5550  ) *CHT  (5550  ) 

C OMMf.N/  AI3RAV/N,  *<  I 000  > 

CI  VI  t N/ PR  I NT/ Jk AX (4  ) . JM  IN  ( A ) , CM  AX (4  ), CM  IN( A ) , SLOPE  1 ( 4| , 

SI  Dl'fc2l  A > .ERROR!  ( 4 ) ,FAfiOH2  C4  ) , AMPL1  (4  ) , A MiPL  2 ( 4 ) » AMPER1  ( 4 ) . 

AM'^IO  (4  ) 

l NT  Mir  R REF  SEC.  RFSTRT  . RF  S TOP  , SCNSRT  ,SCNS  TP  , BEG  I N . RE  FHEO 
I N r t r.t  R SCN  1 , SCNHED  . SCNCHK  .END  . T START  ,X  S .ENOSEC 

O I Mi  NS  ion  I r.  AO  do  ) . IHEACl  5 ) .SCN1  ( 5)  . IR  I ( 5!  . IP2(  E)  . I SI  ( 5 ) , I S2(  3 

00  20  J-  1,2700 
SUM ( J)  -0.0 

JUMP  T 1 
AN(.  = PH  l. 

a a i n -r.  a 

DO  50  I0HAN=1,4 

J MA  X < I ('  f)A  N)  =0 
JMI  N(  I OIA  N|  -o 
CMAX  ( 1 CHAN) =- 99999. 

C MI  N(  K.MAN)  = ’>9999  . 

SLOPE  1 ( I CHAN) =0 . 

SLOPE? ( I CKAN)=0 . 

E RP.OR  I ( I CHAN)  =0  . 

ERROR? ( 1 1 HAN)  = 0 . 

AMfU.l  < I C H A r!  ) = 0 . 

A MPL 2 ( 1 CHAN)  -0. 

AMPER1  ( I CHAN  ) =0  . 

AMPt  9 2 ( ! CHA  N) =0  . 

CONTI  NUF 

DO  70  J"1  .5 

1 R l < j ) - iRtr l ( j) 

1R2  ( J ) = IRUI  ?(  J ) . .. 

I SI  < J)  = I SCANl  ( J > 

I S2( J) -I SCAN2( J) 

CO  NT  1 NUf  _ _ . ...  

I F (LREF  , EQ.O  ) GO  TO  90 

CONT  I NOE 

CALL  F LTADJ( N. I Cl  . I R2  ) _ _ 

CALL  FLT AOJ ( N.  I SI  . I S2 ) ... 

CCMINUE 

CALL  HD2SEC ( I 9)  . IP)  SEC) 

CALL  H02SFC ( l 92 , IR2 SEC ) 
l MSEC  = I P2  SEC- 191 SEC+1 
IF  ( IPSEC. Lfcr.l  5»  0)  GC  TO  30 
XS= I RS  EC- 1510 

PRINT  10. XS  _ 

GO  TO  440 

CALL  H02SEC( 1ST, IS1SEC) 

CALL  H 02  SEC  ( I S2  .IS2SEC)  . . 

I 35E  C--I  S2SF-C-  1S1  SEC*1  _ _ „ ... 

CALL  HD2SEC ( I REF1  , RFSTRT ) 

CALL  HD2SFC  ( I9EF2  .RFSTOP)  _ ..  

REI  SECUREST  CP-RFSTRT*  1 _ ... 

IF ( PEFSEC.LE.l 51 0)G0  TO  100 
XS  =Pf.F  SEC  — 1 51  0 

PCI  NT  lO.XS  

FORMATdX, ‘LENGTH  OF  REFERENCE  EXCEEDS  DIMENSION  BY  _?*I7»  _.. 
STOP 

CALL  HC£SEC(  ISCAM  , SCNSRT  ) 

CALL  HD2SEC ( I SCAN2 . SCNSTP)  _ _ _ _ _ 

NS E C= SCNS TP— SCNSRT  +PEFSEC  _ _ 

END  SEC  = SC  N5  T P — SCNSRT  N l 
IF ( LREF .LQ.O ) ISSFC»NSEC 

1 F ( LFT F ,NE  .0 ) I SSEC=  ISSEC-*REFSEC-1__  

I F ( I SSEC.  LE  . 421  0)GO  TO  110  


m 


I 'iMlIU  W'flHIf '"il 
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I SN 

00  74 

XS  = I SSt  C-421 0 

I SN 

0 0 76 

PMNT  1 1 .XS 

I C'N 

007* 

1 1 

F OUMAT( 1 x,» LENGTH  cf  scan  exceeos  DIMENSION 

IbN 

007  7 

r 

stop 

V. 

c 

c 

OF  T NEFF  HI  MCE  FROM  TAPE 

I ‘jN 

00  7b 

110 

IF  (SCNSFT.IT.HFSTOTI  JUMP*2 

! SN 

OC-HC 

GO  TO  (111. 20* ) , JUMP 

I SN 

0Q0  1 

1 1 1 

CALI  r IND ( |p l . 1H2 ) 

I SN 

0082 

r ALL  OSPYK  < 8 > 

I SN 

0083 

If  ( C.A  IN. Ml  .0.  > CAUL  RCT  ATE  (PHI  . GA  IN  ,0  1 

I SN 

0065 

IF  (LRfF.CC.n  ) (1C  TO  120 

I SN 

0 0 8 7 

CALL  OOF  I LT  ( 0(1  ,W  ,N.O  » 

I SN 

0088 

IF  ( GA  1N.NE  . 0.  ) GO  TCI  115 

I SN 

00  TO 

CALL  OCT  I l T ( 0(2  ,W  . N,  0 » 

I SN 

0 0 91 

CALL  OOF  I LT  ( CM3  ,w  , N .1  ) 

I SN 

0092 

GO  T 0 120 

I SN 

000  3 

1 1 6 

CALL  DCFILT  (ClIR  iXiN.P  ) 

I SN 

0004 

CALL  OOFILT(CMT.».N.l  1 

I SN 

ocos 

120 

WPI  Tt  ( 1 1 1 C HI 

r sn 

0090 

KUMP *2 

I SN 

0097 

IF (GA IN.NE .C . 1 GO  Tfl  130 

I SN 

0099 

W R 1 TF  ( 1 2 1 CH2 

1 SN 

01  CO 

WRI  TEC  1 31  CM3 

I SN 

0101 

GO  TO  ( 200.  350  1 . JUMP 

1 SN 

0102 

1 30 

WRI TF ( 1 2»  LHP 

I SN 

0103 

WRITE (131  CHI 

! SN 

01  04 

GO  TO  (200 . 3^0  1 « JUMP 

I SN 

01  05 

£ 

200 

CALL  H02SLC < I SI  . ! SI  SEC  1 

I SN 

01  06 

L E N = I S 1 Sl.Cf  ISStC-l 

I St. 

0107 

CALI  SEC 2HD ( L£N  . 1 S2  1 

I SN 

01  08 

CALL  F INO(  I 51 . I S2  1 

I SN 

0109 

CALL  DSPYK(O) 

I SN 

0110 

I r ( GA  IN .NE .0 . ) CALL  ROT  AT E (PHI  . GA  IN.O  » 

I SN 

01  ’ 2 

IF( LREF.t Q.O)  GC  TO  220 

I SN 

0 114 

CALL  DOFILT  (CHI  .W.N.O  1 

I SN 

0115 

I F ( GA  I N.  NE- . 0.  »•  GO  TC  210 

I SN 

0117 

CALL  OOF  I LT ( CH2  ,W . N, 0 1 

I SN 

oi  i e 

CALL  OOF  1 LT  ( CH3 .W . N.  1 1 

I SN 

0119 

GO  TO  220 

I SN 

0120 

210 

CALL  OOF ILT  (CHR .W.N.O  1 

I SN 

0121 

r 

CALI  OOF  I LT ( CUT . W. N .1  » 

I S f 4 

3 1 22 

V. 

220 

WR  I T E ( 1 1 > CHI 

I SN 

01  2 3 

[FIGAIN.NF.P.I  GC  TC  3l0 

I SN 

0125 

wR  I TC  ( 12  ) CH? 

I SN 

0126 

WRITE(13>  CHI 

I SN 

0127 

GO  TO  ( 35  0.  Ill),  JUMP 

I SN 

0128 

330 

WR  I TF  ( l 2 1 C HR 

1 SN 

01  29 

WRIT  F ( 1 3 ) CHT 

1 SN 

01  30 

r 

GO  TO  ( 350.11 1 ) . JUMP 

I SN’ 

01  31 

350 

CONT  JNUF 

I SN 

0132 

FNOFILF  11 

I SN 

0133 

RE W INC  11 

t SN 

0134 

ENDFILE  12 

I SN 

0135 

RE  W I NO  1 2 

! SN 

0 1 36 

ENOFILE'  13 

I S* 

0137 

RFWINO  13 

! ^ 

C 1 38 

440 

RE  TURN 

1 SN 

01  -»9 

ENO 
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NAME  --C0RRL8 

TYPE- -DATA 

SOURCE--D.  CHESLEY 

PURPOSE--  cross  correlation  of  one  array,  called  the  reference, 
with  another,  called  the  scan.  Operates  on  one  channel. 
Successive  calls  create  an  average  trace  that  is  the  arith- 
metic mean,  point  by  point,  of  all  the  calculated  correlation 
coefficients.  Each  call  generates  three  plots:  reference, 

scan,  and  correlation  coefficients,  in  that  order. 

DESCRIPTION--  CALL  C0RRL8  (ICHAN,  SCALE,  HYT,  LAB,  NUMCH) 

ICHAN  - channel  number  to  be  correlated.  1 “ CHI,  2 ■ CH2 
or  CHR,  3 - CH3  or  CHT 

SCALE  - horizontal  scale  of  plotted  output  cm/min 

HYT  - height  of  plot  In  inches  (from  minimum  to  maximum, 
not  Including  label) 

LAB  - plotting  label  parameters  (see  PLT1) 

» 0 no  rotation  or  filter  labels 
« 1 rotation,  no  filter 
» 2 filter,  no  rotation 
« 3 rotation  and  filter  labels 
NUMCH  - number  of  channels  that  are  combined  in  sum  (average 
correlation)  trace  (one  CALL  C0RRL8  for  each  channel) 
COMMON  - /SMACK/  contains  header  information  for  PLT1  labels 
/SEARCH/  contains  data  and  correlation  coefficients 
/X/  contains  lengths  of  plotted  arrays 
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/COR/ 

/ANGLE/ 

/TURN/ 

/PRINT/ 

/TIME/ 


contains  sum  trace  and  reference,  origin,  and 
scan  times 

contains  rotation  information  for  PLT1  labels 
contains  rotated  data 
contains  output  for  TABLE 

contains  lengths  of  arrays  and  JUMP,  which  gives 
order  of  scan  and  reference  in  time 


NOTES- -C0RRL8  reads  files  that  have  been  created  by  COREAD 

(or  a similar  process).  There  is  JCL  interaction  here. 
Channel  1 data  must  be  stored  in  file  11,  2 in  12,  and 
so  on  (see  sample  program).  C0RRL8  plots  the  reference 
and  then  the  scan.  For  correct  timing  information,  the 
data  must  be  one  point  per  second.  C0RRL8  performs  the 
correlation,  plots  the  coefficients  and  calculates 
correlation  amplitudes.  C0RRL8  divides  each  coefficient 
by  NUMCH  and  adds  the  coefficients  to  the  values  in  SUM. 
This  results  in  an  average  correlation  after  all  correla- 
tions are  finished.  (There  must  be  NUMCH  calls  to  CORRL8) . 
C0RRL8  passes  the  output  to  TABLE  for  printing.  The  sum 
trace  must  be  plotted  by  the  main  program. 
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I SN 

0002 

LSN 

0003 

l SN 

0004 

l SN 

0005 

ISN 

-00  06 

I SN 

0C07 

I SN 

OOOP 

I SN 

0 00,9 

ISN 

0010 

ISN. 

.00  I 1 .. 

ISN 

0012  , 

1 SN 
1 SN 
ISN. 

00  1 3 

001  4 

0015 

c 

I SN 

001  6 

l SN 

001  7 

5 

1 SN 

ooi  e 

I SN 

0019 

6 . 

I SN 

0020 

7 

I SN 

0021 

ISN  0023 

ISN 

Q024  . 

I SN 

0025 

I SN 

0026 

ISN 

0027 

I 0 0. 

I SN 

0029 

I SN 

0 02  9 

c 

c _ 

_c 

I SN 

00  30 

125 

I SN 

0031 

.1  SN 

0032  . 

ISN 

0033 

1 30 

I SN 

00  34 

I SN 

0035 

I SN, 

0036  . 

1 33 

I SN 

00  3 7 

I SN 

0035 

135 

I SN 

0040 

I SN 

004  1 

136 

I SN 

0042 

I SN 

0043 

137 

1 SN 

0044 

ISN. 

0045 

1 36 

ISN 

0046 

139 

I SN 

004  7 

I SN 

o 04e 

1 40 

ISN 

0049 

c 

C 

c 

c 

1 r N 

0050 

200 

1 SN 

006  t 

SUBROUTINE  CORRLBI  I CHAN . SC ALE . HY T , L A8 . NUMCH > 

COMMON/ SWA.CK./AU.555.)  * A2X555-)  . A 31.5 55  > . HI  (13 U_.a2(  1 1 1 J , 

-.B3(  i j ijljhisadxi.o  ) , iae_c _ 

COMMON  /SEARCH/C HI  (5  550 ) . CH2( 5550  > . CH3I  5 550  > 

COMMON/X/ IXMAX 

COMMON / CQfi /SUM (.2.7-0 0. ). j. -LfiEJF.  11 5 ) . 1FEF2(5>  . J.QR1G15J  . 

_«JLS£ANJX5).»  1 SCAN2.C  5 I 

COMMON/ ANGLE/ ANG.GA IN 
COMMON/TURN/CHR ( 5550  > ,CHT ( 5550 ) 

_C0MM0NZeRUtir/-J«AAC4  I. *.  JM.LN X 4 )-•  CM-4 X ( 4 ) • CM  1 N t_4 ) .SLDPE.1  <4  1. 

. SL  QPE2J4.)..  .ieaoftij  4 >...EfiRQR2(4  ),  AMPL1  (A)  , 4MPL21A)  • AMP  HP  1 1 ‘ 
. AMPPR2 (A) 

COMMON/TIME/NSEC.REFSEC .RFSTRT. SCN3PT , JUMP.ENDSEC 

. .PI  VHtlSJ.UN  LEAa(JL0JjJLtl£Aa(J5Li 

LN  TJE.GE.R  -ENDSEC 

INTEGER  REFSEC. RFSTRT .SCNSRT , T START 

DOUBLE  PRECISION  SUMX . SUM Y , SUMX2 , SUMY 2 . SUMX Y .D 1 . 02 , D3 


IF (LAB- 1 ) 5,5.6 
LABE  =0 
-SQ_jrCL_T- 


_labi=  =2 . 

JCHAN=ICHANM0 
IF( JUMP.E0.2 ) GO  TO  100 
-P  E AP  tJLChiAN  ) CHJL 


JBSA  D_(jCyA  NJL_CH2 

REWIND  JCHAN 
GO  TO  125 

R.F.A D(  JCHA Ni_C U2 

BEAD  ( JCHA N1_£>U 

REWIND  JCHAN 


-PL  OJ-BEFER  EN.CE-- 


1 ) 


CALL  HDCONV ( IREFI 
I XWAX=REFSEC 

PP  I NT 13Q  , ICHAN 

.FORM  ATJ  LX,/,* REFERENCE! CHANNEL.  A*  .II.  /J 

CALL  MAX  M I N ( CHI  , I XM AX . REFM A X . M AX J . P EF M I N ,M I N J I 
GO  TO(  1 33 .1 35. I 35 > • ICHAN 

_c  a li ecu,  t chjl.js£  all.hvi,  o..  . o » j _*  a i jl.  o . i_a  b ej 

_G0_  10-200. 

I F( GAIN.NE. 0 . ) GO  TO  138 
GO  T0( 133.136.1  37),  ICHAN 

..CALL  PLT  1 (CH-1  .SCALE-.  HXX,  O •-  .-0,  » 42*  ,-O.LABE) 

..C0-TP..2.00 

CALL  PLT 1 (CHI  , SCALE » HYT . 0 . . O . . * A3 • . 0 . L A B E ) 

GC  TO  200 

_.0  Q.-  -T.C1_  (.  1 3 It-l.iSj  3 4 O..L»  I CHAN — - 

CALL  PL.TUCHIjSCAEEjMXT-i.0.,  ,Q.  ,JLAR1»-0.<lLAB). 

GO  TO  200 

CALL  PLT1 (CHI .SCALE .HYT .0, . 0 . . • AT • . 0 .L A 0 ) 

GO..  TO  _2.au 


c 

c 

C 


CONVERT  HEAOER  TO  DESIRED  START  TIME 

CALL  SEC  2HCH  S C NS  fi  t . 3 HEAD  )”  . 
call  HDCONV ( IH6 AD. -I > 

PLOT  SCAN . 
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I SN 

0052 

I XMAX=NSEC 

I SN 

005  3 

► ’PINT  275, ICHAN 

I SN 

0054 

275 

F FIRM  AT ( 1 X ./ ••  SCAN:  CHANNEL  A*. 11. /» 

t SN 

0 055 

GO  TO  (280.201 .281 ). 1CHAN 

I SN 

00S6 

280 

CALL  PIT  1 (C  M2  .SCALE  . HYT,0..0..,A1'.0,|A8EI 

I SN 

0057 

GO  TO  300 

I SN 

0050 

281 

1 F ( GA IN. NE. 0. ) GO  TO  285 

I SN 

0060 

GU  TO  ( 280 .282 .283 1 . ICHAN 

I SN 

0061 

282 

C Al  L PLT 1 (CM2 . SCALF  .HYT .0 . .0. . • A? • ,0 .LABE ) 

I SN 

0062 

GO  TO  300 

I SN 

0 06  3 

28  3 

CALL  PLT 1 (CM2 . SC ALE . HYT  . 0 . . 0 . . ■ A3 • . 0 . L A HE  » 

I SN 

0064 

GO  TO  300 

r sn 

00  65 

285 

GO  T O ( 280 .286 . 287 I . ICHAN 

i sn 

0066 

286 

CALL  PL  T 1 (CM2 .SCALE .HYT .0. . 0 . • • AR • . 0 . CAB  I 

I SN 

0067 

GU  TO  300 

I SN 

0068 

287 

C 

C 

CALL  PL  T 1 ( CH2 ■ SCALE .HYT iO.iO.i  •AT'.O.LABJ 
CONVERT  HEADER  TO  DESIREO  START  TIME 

ISN 

0 06  9 

Q 

300 

CALL  H02SEC( 10RIG. ITIMEI 

! SN 

0070 

T ST  4R  T = SC.NSPT  - RFST  MT  F I T IME 

I SN 

007  1 

CALL  SEC2HD(TST ART, IHEAOI 

I SN 

0072 

C 

C 

C 

c 

c 

CALL  HDCONVf  IHEAD.-l  1 
***  OF  G I N CORRELATION  ROUTINE  * * * 
FIRST  CALCULATE  CONSTANT  TERM 

I SN 

0073 

SUMX2=0. 0 

I SN 

0074 

SUM  X =0 . 0 

1 SN 

0075 

DO  325  1=1, REFSEC 

I SN 

0 0 76 

SUM  X 2 = SUMX2 ♦CH1(II*CH1(I1 

I SN 

0077 

SUMX  = SUMX  4-CHI  ( I > 

ISN 

0078 

325 

CONTINUE 

I SN 

0079 

L 

c 

c 

c 

D2  = REE  S EC *SUMX2- SUM X * *2 
NOW  CALCULATE  OTHER  TERMS 

I SN 

0080 

SUMY  = 0.  0 - . - __ 

I SN 

0081 

SUMY  2 = 0. 0 

I SN 

0082 

326 

CONT I NUF 

1 SN 

0083 

DO  400  J= 1 • ENDSEC 

ISN 

0004 

SUMX  Y = 0. 0 

I SN 

0085 

DO  375  1 = 1 . REFSEC. 

1 SN 

0 0 8 6 

IF ( J.NE. 1 ) GO  TO  370 

ISN 

0080 

SUMY =SUMY FCH2 ( I F J- 1 ) 

ISN 

0089 

SUM  Y 2=SUMY  2 F C H 2 ( I ♦ J- 1 > *CH2 ( I FJ- 1 ) 

1 SN 

0090 

370 

SUMXY=SUMXYFCM1 ( I»*CH2( I FJ-1 » 

I SN 

0 091 

375 

CONT I NUE 

I SN 

0092 

V. 

I F ( J.EQ.l 1 GO  TO  380 

1 SN 

0094 

SUMY = SUMY -SUMYSFCH2( REF SECFJ-1 > 

I SN 

0095 

SUMY2=5UMY2-SUMY?SfCH2(REFSECFJ- 1 I *C H2( REF S FC f J- 1 ) 

I SN 

0096 

380 

SUM  Y S = CH2 ( J ) 

I SN 

0097 

C 

C 

c 

SUMY  25  =CH2 ( J > *CH2 ( J ) 
CORRELATION  COEFFICIENT 
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I SF 

009H 

0 1 -*M  t st  c ii"  « r sumx»sumy 

1 SN 

009  9 

0 3 ll  1 S»  ( •'  IIWY.'-S  ' IM  Y • * 

1 SN 

0 1 00 

OV(  It  -111  /oSORT  (02*1-  J) 

I SN 

01  ol 

c 

c. 

c 

c 

jl/41  J | ,U  Ml  J > H'llc  1 It/  NUMC  11 

(H|I||  F II.  MAXIMUM  AND  MINIMUM  AND  CAl.CUl.ATf 
FUROR  AND  SLOP!  II  NtCfiSARY 

1 V.  N 

0 t 02 

< 

IF  ( ( H.  ( J)  .uL.CMax  ( 1 CHAN)  > GO  to  390 

l SN 

0 1 0 4 

JMAAt  1 ( IIAM  ijl  T STAN  T — l 

1 SN 

0 I 0‘. 

C MAX  ( 1 < I1ANI  - C M2  ( J > 

1 SN 

01  ot 

SI  IP!  | < I < HAN)  -01/02 

I SN 

0 107 

t 

1 R hi  IK  1 ( I (HAN)  = PS(Jo  T (<  03/02- St  (IPF  1 ( F PHAN ) 4*2 )/<  R FFS)  C. 

1 b N 

oi  te 

V- 

390 

1 f ( (.  M2  < J)  aStiCMI  N|  1 CH  AN  ) ) GO  TO  400 

1 SN 

oiio 

JM| N(  I .HAN) - J *-  T ST APT- 1 

! SN 

01  1 1 

C M 1 N ( l CHAN)  =(.112  ( J I 

1 SN 

0 112 

St  UPF2  ( I CH  AN)  =DJ  / 02 

I SN 

01  1 3 

C 

4 00 

f Dpi  IP  2 ( KM  AN)  -DSO'3  T ( ( 03/D2-SLUPE2  C l CM  AN  ) 4 *2  ) / < * £ F St.  C 

1 !)N 

01  1 * 

C CNT 1 NUF. 

1 SN 

oils 

401 

CPN T | Not 

I SN 

011c 

01  F -Pf.f  MAX-  REF  M IN 

I SN 

0117 

AMIU  1 < 1 CHAN)  =01 F4 SLOPE!  ( 1 CHAN  ) 

I SN 

oi  la 

A Mr*  1.  2 1 I CHAN)  = O!  F4  st.  OP  F 2 < I CHAN  ) 

I SN 

01  1 9 

AMPI.  PI  ( I CHAN)  =0  IF*F  RPOPl  < I CHAN  1 

I SN 

0120 

AMPEP2(  I CHAN)  =DIF  *t  RROR2  l I CHAN  ) 

I SN 

0121 

402 

C 

c 

r 

CONTI  NUT 
PLOT  Rf  SUI  TS 

1 SN 

01  22 

V» 

I AM  AX  =LNPSLC. 

I SN 

0 123 

GO  TO  (410.420.420). ICHAN 

ISN 

01  24 

4 1 0 

CALL  PL  T 1 <CH2 ,SCALF , HYT . 1 . 1 . . *C  1 • .0.0 ) 

I SN 

01  25 

GO  TO  440 

I SN 

0126 

420 

1 F< GA IN. NE. 0. )G0  TO  430 

I SN 

oi2a 

GO  TO  ( 4 l 0 .425. 426 ) . ICHAN 

t SN 

01  29 

425 

C ALL  PLT1  (CII2.SCALE.HYT.1  . .-1.  ,,C2*  ,0.01 

I SN 

01  30 

GO  TO  440 

1 SN 

0131 

426 

CALL  PL  T 1 CCH2 .SCALE. HYT .l..-l..!C3".0.0l 

t SN 

01  "<2 

c 

GO  TO  440 

ISN 

01  33 

4 3 0 

GO  TO  (410. 4J5. 436)  . ICHAN  

I SN 

01  34 

435 

CALI  PL  T 1 ( CM2  .SCALE. HYT  ,1..-1..,CP,.0.0) 

I SN 

01  3 c 

GO  TO  440 

ISN 

0 1 36 

4 36 

c 

C ALL  PLT 1 (CM2 , SCALE . FYT.l..-i.,'CT*.0.0> 

I SN 

0137 

V 

440 

RETURN 

I SN 

01  3 P 

END 
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NAME- -DOFILT 

TYPE  - -F  ILTER 

SOURCE--D.  CHESLEY 

PU RPOS E - -F ILTERS  an  array  of  time  series  data  using  coefficients 
calculated  hy  BPFILT,  HPFILT  , LPFILT  and  NAMING.  DOFILT 
filters  with  a correlation  technique  in  time  domain. 

DESCRI PTTON--CALL  DOFILT  (A,  W,  N,  ICHG) 

A - the  array  to  be  filtered  and  the  array  after  filtering 
W - array  containing  the  filter  coefficients 
N - 2*N+1  is  the  number  of  coefficients  (slOOO) 

ICHG  - The  correlation  technique  used  in  DOFILT  changes 
the  length  of  the  array  after  the  correlation  by 
dropping  N points  from  each  end  of  the  array.  ICHG 
^0  changes  IXMAX  and  the  start  time  that  goes  with 
the  array  A. 

COMMON --/SMACK/  contains  HEAD(IO),  which  contains  the  start  time 
of  the  data 

/X/  contains  IXMAX,  which  is  the  length  of  A.  Both  these 
quantities  are  changed  by  DOFILT  if  ICHG^O. 

NOTES  — If  the  user  wants  to  filter  all  three  A channels,  then 
the  value  of  IXMAX  and  the  start  time  in  HEAD(10)  should 
be  changed  only  once.  This  should  be  done  on  the  last 
call  to  DOFILT  as  below: 


' PRECEDING  PAGE  BLAMUIOT  PILMSff 

jinwy;  . — ' ' 


30 


CALL 

HPFILT 

(W,  N,  DLT,  HPFREQ) 

CALL 

NAMING 

(W,  N) 

CALL 

DOFI LT 

(CHI,  W,  N,  0) 

CALL 

DOFILT 

(CH  2 , W,  N,  0) 

CALL 

DOFILT 

(CH  3 , W,  N , 1)  . 

I SN 

0 00  2 

I SN 

0 003 

I SN 

OtOA 

I Sn 

0 005 

I SN 

0 C06 

I SN 

0 00  7 

1 SN 

0 00  ft 

I SN 

0 CO  9 

I SN 

0010 

I SN 

0 01  1 

I SN 

0 012 

I SN 

0 013 

I SN 

0 01  A 

l SN 

0 Cl  5 

I SN 

0 Cl  6 

I SN 

0 Cl  7 

1 5 

I SN 

0018 

I SN 

0019 

20 

I SN 

0 02  0 

1 SN 

0 021 

22 

I SN 

0 02  2 

I SN 

0 02  3 

T SN 

0 02  A 

I SN 

0 C 2 5 

I SN 

OOP  6 

I SN 

0027 

A 0 

! Sn 

0026 

I SN 

0 029 

999 

I SN 

0030 

SUBROUTINE  oof ILT (A ,w ,N, ICHG) 

C OMM  ON/  SMACK/AM5  55)  , A 21  566)  . A3  I 555)  .Bl(  1 1 
.83 (111)  . Ht  AO ( JO ) , IREC 
C OMMON/ X/ 1 XWAX 

D l ME  NS  ION  A < 1 ) ,W  I l ) t I Ht  AO(  5 ) . I E AO  ( 1 0 1 
EQUIVALENCE  < HEAD  1 1 > . I E ADI  1 ) ) 

LCHG  - I CMC, 

I N = 1 . 

N 1 =N*  1 
N2  =1  XMA  X-N 
I l=2INt| 

00  20  J - N1  ,N2 

1 M IN  = J-N 
C OEF  =0  . 

DO  15  1=1.11 

COEF  =COEE*W(  I ) *A<  IMINO-1  ) 

CO  NT  INUE 
A ( J-N)  =COEF 
CO  NT  INUE 

I F ( L CH<J  ) 22,999.22 

I XMA  X=l  XMAX-2*N 
CALL  HDCONV C I HEAD , 1 ) 

CALL  H02SECI 1HEAD.1S) 

1 S = I S+N* IN 

CALL  SEC  2 HD  I IS,  IMEAO) 

DO  AO  J = l ,A 

IEAD  < J + 2 > = 1 HE ADI  J ) 

HEA0(7)=IhEA0(5) 

RE  TURN 
END 


1 ) ,B2(  1 1 1 ) , 


NAME-  -DSPYK 


T Y P E - -U  T 1LIT Y 
SOURCE--D.  CHESLEY 

PURPOSE--Removes  spikes  from  data,  three  A channels  simultaneously. 
DESCRIPTION- -CALL  DSPYK  (NUM) 

NUM  = 0 is  used  if  the  data  has  been  read  using  FIND;  NUM  = 

1 If  READ  has  been  used  to  get  the  data  from  the  tape. 
COMMON- - /SEARCH / contains  data  before  and  after  despiking  if  NUM  = 0 
/SMACK/  contains  data  if  NUM  = 1 
/X/  contains  length  of  the  data 

/SPIKE/  contains  information  for  PLT1  giving  locations 
where  spikes  have  been  removed  from  each  channel 

NOTES--  DSPYK  finds  spikes  by  considering  slopes  between  successive 
data  points. 


If  S * S Is  negative,  a peak  (either  high  or  low)  has  been  passed. 

1 2 

If  YMIN  is  the  minimum  value  in  the  array  and  YMAX  the  maximum, 

2 

then  the  peak  is  considered  a spike  if  * S£  < -0.1  * (YMAX-YMIN)  . 
When  a spike  is  detected  at  n,  the  tape  data  are  replaced  by  a 


straight  line  connecting  n~2  with  n+2 . The  program  makes  several 
passes  through  the  data  (since  YMAX  and  YMIN  may  change  when  a 
spike  is  removed)  until  It  makes  a pass  in  which  no  spikes  are 
found.  All  spikes  found  in  the  HGLP  station  tapes  were  only 
three  data  points  long. 

Line  104  + 1 is  the  statement  that  determines  how  sharp  a 
peak  must  be  to  be  considered  a spike. 

With  the  appropriate  arguments,  PLT1  plots  an  asterisk  at  the 
location  of  each  removed  spike. 

DSPKY  operates  on  the  three  channels  (CHI-3  or  Al-3)  in  a 


single 

CALL 

statement . 

ISN 

0002 

SUBROUTINE  OSPYK(NUM) 

I';n 

000  3 

COMMON2S  E ARCH/ CHI  <555C').CH2(5550).CH3<55S0) 

I SN 

0004 

COMMON/A/ 1 XMAx 

ISN 

0005 

COMMCIN/SM4CK/Al(5  5f>)  , A 2<  5551  ,A3<555>  .61  <1  1 l 1 ,B?<  1 1 1 ). 

.03(11  11,  HE  AO  ( 1 0 I , IREFC 

1 SN 

0006 

CONMON/SPIKE/SPIKI  (500I.SPI K2  <600  I .SPIK3I500  )•  ICNT  1,  1CNT2 

ISN 

000  7 

REAL  MASrfc'R 

I SN 

6008 

D I ME  NS  ION  MASTERISOO. 31.  tCNT ( 3 ) , l E AO(  l 0 > 

I SN 

0009 

DIMENSION  YMINI3)  .YMAX (3 ) , CH(5550.-3).XL1M<3) 

ISN 

00  10 

EQUIVALENCE  (CHI  1 ,1  I.CHll  l)  ) ,(CH(  1.2)  ,CH2(  l.)  I, 

. (CHI  1 .3 1 . CH3 ( 1 ) ) 

ISN 

00  11 

EOUI VALENCE ( HE AO < 1 > , 1 E AD<  l )J,(MASTFR(1  ,1),SP|K1(1  >1 

ISN 

00  12 

C 

C 

c 

E OU  1 V Al.  ENCE  1 MASTER  C 1.2),  SP  1 K 2 ( 1 )),  I MASTER!  1.3)  .SP  1 K3  ( 1 ) ) 

INI  T I AL1  ZE 

l SN 

00  1 3 

V. 

MA XNU  M=500 

ISN 

00  14 

DO  75  ICH=1 . 3 

I SN 

00  1 5 

DO  74  J= 1 , M A XNUM 

I S N 

00  1 6 

74 

MA  ST£R(  J,  1CH)=0 

I SN 

00  17 

75 

ICNT( ICH ) -0 

I SN 

001  8 

ISUM2-0 

I SN 

0019 

IF(NUM.NE.I)  GO  TO  100 

C 

c 

ROUTINE  IF  DSPYK  IS  CALLED  FOLLOWING  READ 

ISN 

002  1 

c 

DO  80  J =1,555 

I SN 

0022 

CM  1 ( J ) -A  I ( J J 

I SN 

002  3 

CH  2(J)-A2(J) 

ISN 

00  24 

C H 3 ( J )=A3(J) 

I SN 

0025 

90 

CONT I NUF 

1 SN 

0026 

1 XSAVE  = I XMAX 

ISN 

002  7 

l X MA  X = 5 55 

c 

c 

FIND  MAX..  M.N. , AND  MINIMUM  SPIKE  SIZE 

I SN 

0028 

c 

1 00 

OO  102  I CH= 1 ,3 

1 SN 

0 02  0 

YM 1 N<  I CH ) = 99999. 

ISN 

00  10 

102 

YM  A X ( ICH ) = - 99999. 

1 SN 

003  1 

c 

DO  10  5 I CH  = 1 .3 

I SN 

0032 

DO  10  4 J = 1 , I XMA  X 

I SN 

0 0 3 t 

YMINl  I CH ) = A M I N1  < Y M 1N(  ICH).CH(J,  ICH)) 

1 SN 

0 0 34 

y M A X ( ICH)=AMAX1(YMAX<  ICH).CH(J.ICH)) 

ISN 

0035 

1 04 

CONT I HUE 

I SN 

00  36 

XL  I M ( ICH)=-.IO*(YMAX(  1CH)-YMIN(  ICH))**2 

ISN 

003  7 

105 

CONTI NUE 

I SN 

0038 

DO  300  l CH= 1 . 3 

33 


c 

c 

c 

CMf (K  FOR  SPIKfeS  AT  PEGINNING  Or  ARRAY 

1 *N 

00  3 9 

V. 

OO  20  0 J - ? . 7 

isn 

00  40 

Si  OPF  --(CMU.  ICH*  CH(  j - 1,  IfH)  I * I CH!  J*  1 .KHI  -CHU.  ICHI  » 

1 SN 

0 0 4 ! 

ITISI  OPf.GI.Xl  INI  ICHI  1 GO  TO  200 

1 SN 

004  1 

tPlJ.EG.J)  CH  <5.  1 CM)*  CHI  6.  If  HI 

1 Sn 

0 0 4 0 

00  I 1 0 1-1.4 

isn 

00  46 

1 10 

CHIt  . rCM»”CHl5,  ICH) 

r sn 

004  7 

ICNM  ! CHI  - 1C  Nt  ( ICH  I ♦! 

1 SN 

0 o 4 t* 

I F ( IC  N 1 1 1 CHI  .G  I . MA  XNUM)  Gil  TO  200 

1 SN 

oo*o 

MASTER!  ICNM  ICHI,  ICH)  - J 

I SN 

oos  i 

200 

c 

C ONI  1 NTIF 

\ 

r 

<HEC*  FUR  SPIKES  IN  MAIN  PART  OF  ARRAY 

1 SN 

oes? 

J X MA  X ~ 1 XMAK- 3 

1 SN 

00*3 

DO  550  J-A.JXMAK 

i sn 

0 0‘,a 

J1 - J-Z 

1 SN 

0 0 OS 

JZ  - JF 2 

I SN 

OOSfc 

SL  OPE  » l C H ( J.  ICH) - CHI J- 1 , ICH)  1 *1  CHI JF  I . 1 CHI -CHI J.  ICHI  1 

1 SN 

0057 

1 F < SL OPE .GT. XL  IMI  ICHI  I GO  TO  550 

I SN 

0 0S9 

CM  FF -CH ( J»  3 . IC H 1 -<?H 1 J 3. ICH) 

I SN 

00  60 

X CN  T - 0 . 

1 SN 

0 0 6 1 

DO  300  K-Jl  • J2 

I SN 

006? 

XCNT  XC  N,T  ♦ 1 . 

1 SN 

0 063 

300 

CHIK,  1 CH I =CHI J-3.  ICH) ♦ XCNT  *DIFF 76 . 

I SN 

0064 

ICNTI  1CH)=ICNT(ICH)H 

ISN 

00  6* 

IF  ( ICNM  ICHI  .GT.MAXNUM)  GO  TO  560 

I SN 

00'.  7 

HASTE  R<  ICNTI  ICHI.  ICHI-J 

I »N 

0 OM> 

650 

C 

c 

f* 

CONTI NUR 

CHFCK  FOR  SPIKES  IN  LAST  TWO  POINTS  IN  ARRAY 

ISN 

0 069 

Jl  'IX  MAX- 2 

I SN 

00  70 

J2 ' 1 XMAX -1 

ISN 

00  7 1 

DO  750  J = J 1 . JZ 

1 SN 

0 0 7? 

J3  - Jl  - 1 

I SN 

0 0 7 3 

JA  ~ Jl *2 

ISN 

00  74 

SL  OPE  = <CH<J.  I CHI  - CHl  J - 1 • ICHI 1 * < CH  < JF  i . I CH) -CHI J.ICH) I 

f SN 

0 "76 

IF  (SLOPE. GT.XLIMI  ICH)  ) GO  TO  750 

1 SN 

0077 

IFIJ.EQ.J2)  CH(J-2.ICH)  = CH<J-3.  ICH  I 

ISN 

0079 

00  590  L = J3. JA 

I SN 

oc«o 

59  0 

CH (L . ICH) =CH< J-2. ICH) 

1 SN 

00m 

ICWK  ICH)  =ICNTI  ICH)F| 

I SN 

006? 

1F(  ICNTI  ICH)  .GT.MAXK|UM)  GO  TO  750 

t SN 

0 0 04 

MASTER!  I CNT  < ICH  . ICH)*J 

1 SN 

ooas 

750 

CONTINUE 

1 SN 

00  wo 

800 

CONT INUF 

C 

c 

CHECK  IF  NO  SPIKES  WERE  REMOVED  IN  LAST  PASS 

I SN 

0047 

c 

1 SUM1  -ICNTI)  )♦  ICNTI  21  ♦ IC  NT  <31 

ISN 

ooas 

IF ( ISUM1 .EO. ISOM2 1 GO  TO  510 

I SN 

0 C 9 C 

1 SUM2 * 1 SUM  1 

| SN 

4(M  i 

GO  TO  1 00 

ISN 

0 0 9? 

B 1 0 

IFINUM.EQ.il  IXMAX-IXSAVE 

I SN 

0 0 9a 

ICNTI  MCNTIl  ) 

I SN 

0 0 C * 

ICNT2ICNTI2) 

I sn 

0 0 '17. 

1 CNt  3-  I CNM  3 1 

1 SN 

0 00  7 

RF  TURN 

f SN 

00  OP 

E NIT 

r 


* 

* 
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NAME - - FASTO 
TYPE- -DATA 
SOIIRCE--G.  FRYER 


PURPOSE--  Computes  the  discrete  Fourier  transform,  either  direct 


or  inverse,  of  a complex  array  of  length  2 where  m is  an 
integer . 


DESCRIPTION --CALL  FASTO  (A,  M,  MODE) 


A - complex  array 


M - power  of  two,  giving  length  of  A 


1 

MODE 

“ 

direct  (MODE  = -1)  or  inverse  (MODE  = +1) 

I SN 

0002 

si/fiwniir  iNr  f astoi  a , m, mode  > 

C 

c 

THIS  Sum-UUTINE  COMPUTES  T PE  DISCRETE  COURIER  TRANSFORM 

c 

A 2**M  SI/L  SINGLE  PRFCIsIGN  COMPLEX  NUMFFER  SERIES  IN  Pi 

f 

c 

USING  THE  COOLEY  — T1JKFY  ALGORITHM, 

c 

A IS  THE  COMPLEX  NUMUFM  SERIES. 

c 

M IS  T nr  POWER  OF  TWO  WHICH  GIVES  THE  NUMBER  OE  PulNTs  |i 

c 

MODE  IS  A NUMBER  WHICH  DETERMINES  WHETHER  1 HE  TRANSFORM 

c 

r 

OIRECT  ( MODE 1 ) OR  INVERSE  <MODE=+l). 

1 SN 

0003 

DIMENS ICN  All ),J(23) 

I SN 

0004 

COMPLEX  A . W , WX . AL M , HOLD 

I SN 

OOOS 

NPTS  = 2**M 

c 

INVERT  SUBSCRIPT  BIT  ORDER  IN  PLACE 

r s n 

0 0 06 

K = 0 

l SN 

000  7 

D 0 t I = 1 . M 

1 SN 

OOOR 

1 

Jill  = 2*  * ( M-  [ | 

1 SN 

0 009 

DO  4 L = 1 * NP  r S 

1 SN 

001  0 

IF  IK.LT.L)  GO  TCI  2 

1 SN 

0012 

H OL  O = A<1) 

I 

I SN 

00  13 

A(L)  = A( k ♦ 1 ) 

- 

! SN 

001  4 

AIK*!)  = HOLD 

t 

I SN 

00  1 5 

2 

DO  3 I = l.M 

! 

1 SN 

0016 

I l = I 

I SN 

001  7 

IP  (K.LI.J(I)I  GO  TO  4 

I SN 

001  9 

3 

K = K-  J<  I ) 

1 

I SN 

00?  0 

4 

K = K ♦ J ( I I ) 

i. 

c 

COMPOTE  TRANSFORM 

I SN 

0 02  1 

XPI  = 3.  141  5926SF.  f 00*  MODE 

► 

, 

I SN 

0022 

W = ( 1 .0. 0. 0 ) 

r sn 

002  3 

NL  = 1 

1 SN 

0024 

DO  30  L = l.M 

I SN 

0025 

WX  = <1.0,0.01 

I SN 

0026 

NL  2 = 2 * NL 

- > 

I SN 

002  7 

DO  20  NSB  = 1 , NL 

I SN 

0 02  H 

00  10  NS U8  = NSB. NPTS. NL2 

1 SN 

0 02  9 

NSLB  = NSUH  + NL 

1 SN 

0030 

ALM  = A(NSLB)»WX 

I SN 

0031 

A < NSLB)  = A<N3UB)-ALM 

PAG' 


s BLANK-.  iOT  filmlS 


3b 


ISN  0032 
I SN  0033 
IbN  0034 
1 S N 003b 
l bN  0036 
ISN  0037 

ISf<  O 03  S 

I C,  N i)04  0 

t <,N  004  1 

IbN  0042 


1 0 
20 


30 


50 


AlNSUBI  = A(NSUBI*4LM 
MX  = W*WX 
NL  - NL*2 

CWPLXKOSlXt’l  I.S1N(XMIII 
IF  ( MODE,  eo.-  1 > RFTUWN 
OlVIDfc  ttV  NORMALIZATION 

00  50  I = 1 »Nt’TS 

A < 1 ) = A(  I > /N»M  S 

RE  TORN 
ENO  F AST  0 

End 


FACTOR 
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NAME- -FIND 

TYPE--IO 

SOURCE--D.  CHESLEY 

PURPOSE--  Reads  data  tape  and  returns  desired  segment  of  data,  A 
channels  only,  in  COMMON / SEARCH / with  a maximum  of  5550  data 
points. 

DESCR1PTION--CALL  FIN,D  (ISTART,  ISTOP) 

TSTART  - (dimension  = 5,  integer)  contains  year,  day,  hour, 
minute,  second  of  first  data  point  desired 
ISTOP  - (dimension  = 5,  integer)  contains  time  for  last 
data  point 

COMMON-- /SEARCH/  contains  data  returned  by  FIND 
CHI  - vertical,  CH2-NS,  CH3-EW 
/SMACK/  - used  by  READ  to  supply  data  to  FIND 

/X/  - returns  length  of  data  in  CHI,  2,  and  3 

NOTES--  FIND  locates  the  desired  records  on  the  data  tape  and  calls 
READ  to  interpret  the  tape.  FIND  then  calls  SHRINK  to  elimi- 
nate unneeded  data.  FIND  does  not  despike  the  data.  FIND 
prints  start  time  of  the  first  record  and  stop  time  of  the 
last  record,  first  and  last  record  numbers,  and  total  number 
of  data  points  (=  555  x numbers  of  records).  These  are  not 
the  times  given  by  ISTART  and  ISTOP,  but  the  desired  times 
should  be  included  in  the  span  printed  by  FIND. 
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I SN 
I SN 
I SN 

t SN 
I SN 
I SN 
I SN 
1 SN 

t SN 
I SN 
I SN 
t SN 

I SN 
I SN 
I SN 

! SN 
I SN 

I SN 
C SN 
1 SN 
I SN 
I SN 
I SN 
I SN 
I SN 
I SN 
! SN 
I SN 
I SN 
I SN 
t SN 

I SN 
1 SN 
I SN 

r sn 

ISN 
I SN 
! SN 
I SN 
I SN 
I SN 
I SN 
I SN 
I SN 
ISN 

I SN 
I SN 
I SN 
1 SN 
I SN 
I SN 
I SN 


If  a record  Is  not  readable,  FIND  replaces  missing  data  with 
straight  lines  . 

FIND  supplies  diagnostic  messages  If  an  EOF  Is  encountered, 
or  If  a record  Is  read  more  than  six  times. 


00  02 

SUBROUTINE  F l NO ( I START,  I STOP > 

0003 

C OMMON/SE  ARCH/ CHI  ( 5550  > . CH2155S0 ) . CH3( 5550 ) 

0004 

COMM ON/ SMACK/ A 1 ( 555)  . A2 < 5 55 ) . A3 ( 5 S5 ) . 0 1 ( 1 1 1 > . 62 4 1 l 1) . 

. B3(  1 1 n .HEAD!  10 ) . irec 

0005 

COMMON/X/l  X MAX 

0006 

INTEGER  RECS, REREAD 

000? 

DI ME  NS  1 ON  I EADf 10 ) , 1ST  ART ( 1 1 , tSTOPI 1 1 , 1 T I ME  1 ( 5 1 . 1 11 ME 2 ( ») 

0009 

DIMENSION  SAVE! 1 6) .RECSI3) 

0009 

r 

EQUIVALENCE  ( I EADM  ) , HEAD  { 1 > ) 

0010 

V 

DO  10  J = t , 3 

00  1 1 

1 0 

RECS ( J 1 =0 

00  1 2 

1 P T - 0 

00  1 3 

REREADS 

00  1 4 

V 

CALL  HD 2 SEC ( I ST  ART , ION ) 

00  15 

CALL  HD2SECI ISTOP. IOFF) 

00  16 

r 

NUMREC- il OFF- ION  1/555 *2 

00  1 7 

V. 

N RE  C = I REC* I 

ooi  a 

20 

r 

CALL  READ! NR£C • IPT1 

00  19 

U 

IF<  1EADI  1)  .NE.-10)  GO  TO  30 

00?  t 

NREC  = 1 REC-1 

0 0 ? 2 

GO  TO  20 

0 0 2 3 

30 

RECSI 3 ) -RECSt  21 

0 024 

RECSI2)  -RECSI  1 1 

0 0 ? 5 

RECSI  I 1 = I REC 

00?  6 

IF  I ( RECS ( 1 1 . NE. RECSI 3 ) ) .AND. (RECSI 1 » .NE. RECSI 2 1 » » GO  TO  40 

0028 

PRI  NT  1Z.  RECS I I 1 

0020 

1 2 

F ORM  A T < 1 x • ' **•*  fiECOPO  '.IS.*  REREAD  ***»•) 

0O3  0 

RERE  AD -REREAD* 1 

00  31 

IF (REREAD. LT. 6)  GO  TO  40 

00  3 3 

PRINT  13 

0 0 74 

U 

FORMAT (IX,’  4444  REREAD  THRESHOLD  REACHED:  EXEC  TERMINATED 

0075 

r 

SToP 

0 0 36 

40 

CALL  HOCONV( ITIME1 , 1 ) 

0037 

CALL  HD2SEC ( I T IME1 . ITl ) 

0039 

l On  1 = I T 1 *555 

0039 

IF ( ( I ON. GE.  IT  1 1 . AND. ( ION.LE. ION1  ) 1 GOTO  100 

004  t 

I S=!ON-I T 1 

004? 

IADD=ISIGn( 1 , IS) 

004  5 

1 S-l ABSI IS1/S55 

004  4 

IF(IS.EO.O)  !S=1 

004  6 

NREC  = 1 RE  C * I ADD* 1 S 

004  7 

IF(NREC.GT.O)  GO  TO  20 

004T 

PRINT  85 

Of)  50 

ftS 

FORMAT! 1 X warning:  BEGINNING  OF  TAPE  *44’) 

0051 

NREC=1 

005? 

GO  TO  20 

005  3 

° 1 00 

I R6C  1 =NREC 

005a 

DO  110  J = 3 , l 0 _ ^ 

0 0 55 

IF { t J. EQ. 71 .DR. ( J .EQ. 10) ) SO  TO  108 

005  7 

SAVEl  J)  *IEADt J) 

0050 

GO  TO  110 

0 0 59 

1 oe 

SAVE ( J>  =HEAD( J) 

0060 

1 10 

CONT  I NUE 

1 SN 

0061 

DO  250  K= 1 . NUMfiFC 

I SN 

0 0 6? 

Jl  = < K- 1 I *555 

I SN 

0063 

OO  20Q  L = l .555 

I SN 

0 0 6'* 

J2- J 1 +L 

! SN 

OOfoS 

CHI ( J?) =A1 <L) 

I SN 

0066 

CM  2 ( J2 ) =A2(L) 

I SN 

006^ 

CH3<  J21 =A3(L  > 

* 

1 SN 

006  8 

200 

CONI  I NUE 

I SN 

0 0 6 9 

IF ( K ,E J. NOMREC1  GO  TO  250 

I SN 

007\ 

NREC  = NP  E C *■  1 

I SN 

007? 

CALL  RE  AO < NREC . I PT ) 

ISN 

0073 

250 

CONTI NOE 

I SN 

00  74 

IREC2=I  FAOO  ) 

I SN 

no  75 

IXMAX  = (IREC2-1REC1M>*555 

I SN 

0 0 76 

DO  260  J=t.4 

1 SN 

0077 

260 

I TI ME2  < J) =1  CADI J*2 ) 

I SN 

00  7 8 

I T I FAE21  5)  =HEAD(  7) 

I SN 

0079 

CALL  HD2SEC1 ITIME2. I H ) 

I SN 

0083 

t H = 1 H 4-  555 

ISN 

008  I 

C 

CALL  SEC2HD1 IH.l TIME2) 

I SN 

0082 

Dfl  275  L=1  , 1 0 

I SN 

0 0 87 

IF  ( (L .EO. 7 ) .OR. < L.En.l 0 ) > GO  TO  27  4 

I SN 

0085 

I E A 0 ( L ) = SAVE < L > 

I SN 

0086 

GO  TO  275 

I SN 

00  87 

2 74 

HE«n(L)=SAVE(U 

I SN 

0088 

2 75 

CONT 1 NUE 

I SN 

0089 

OO  350  J=1 . I XMAX.555 

I SN 

0090 

I F (CHI ( J ) . NE. 40000 ) GO  TO  350 

ISN 

00Q2 

J 1 = J- i 

I SN 

0093 

IF  ( J1 .EO.O ) GO  TO  310 

I SN 

0095 

H 1 =C.  H 1 < J 1 ) 

I SN 

0096 

H2=CH2<  J l ) 

I SN 

0097 

H3=C.H3<  Jl  J 

I SN 

0098 

GO  TO  330 

I SN 

0099 

° 3 10 

J 1 = J 4 5 55 

I SN 

0100 

IF  ( Jl .GT. I XMAX ) GO  TO  320 

I SN 

0102 

H1=CH1 ( Jl ) 

I SN 

0103 

H2=CH? (Jll 

I SN 

0 1 Oft 

H 3 -CH  3 ( Jl  ) 

I SN 

0105 

GO  TO  330 

I SN 

0 106 

320 

H 1 =0.0 

ISN 

0107 

H2=0.0 

I SN 

0108 

M3  — 0 • 

I SN 

0 1 G9 

330 

DO  340  Jl =1 .555 

I SN 

0110 

j?  = jf  Jl -1 

I SN 

0 111 

CHI  ( J 2 I=H1 

I SN 

0112 

CH  2 { J 2 ) =H2 

I SN 

0113 

CH  3(  J2  ) =H3 

I SN 

0114 

340 

CONT 1 NOE 

I SN 

0 118 

150 

C C j N T I NUE 

I SN 
I SN 

cc 

4 00 

PRINT  4Q0 . I RFC 1 t 1REC2  » I XH  A X ? I TIME  1 . I T1ME2 

F ORM  A T ( 1 X , • ST  ART  RE.CORD=  • . 14  , • . STOP  RF  COR  0=  • . I 4 , • , »,17, 

..  data  points* i *, TsTARt  t 1 MF=* , i 4 , •/ • , 13. •/ • . i 2. • : • , 

• I ?.*;*. 1 2. • . stop  T ime  = * • 1 4 . « /• . i 3. • / • . 1 2. • : • . I 2. • : • . I 2. /> 

I SN 

01  1 B 

CALL  SHRINK!  1ST  ART,  ISTOP) 

. 

I SN 

0119 

RE  TORN 

\ 

I SN 

01  20 

END 

> 

<*• 

I 

# 

r 
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NAME- -FINDB 
TYPE  - - 10 

S0URCE--D.  CHESLEY 


PU RPOS E - - S im i 1 ar  to  FIND  but  returns  B channels  with  any  desired 
spacing  between  successive  data  points. 

DESCRIPTION  - - CALL  FINDB  (ISTART,  ISTOP,  INTER) 

ISTART  - same  as  FIND 
ISTOP  - same  as  FIND 

INTER  - desired  spacing  between  data  points  in  seconds. 
INTER  should  be  an  integer  multiple  of  5. 


C0MM0N--same  as  FIND 


NOTES--FINDB  performs  the  same  function  as  FIND  except  that  FINDB 


fills  CHI,  CH  2 , and  CH3  with  B-channel  (displacement)  data. 
FINDB  does  not  correct  for  parity  and  tape  reading  errors, 
thus  the  user  must  check  the  data  required  from  the  tape 


prior  to  using  FINDB. 


I SN 

0002 

SUBROUTI  NE  F l NDBI  1 START  . I STOP.  I NTER  1 

T SN 

0003 

C OMMON/ SEARCH/C  HI < S55  0 1 .CH2I5S50)  .CH3(5550  » 

I 5N 

00  0 4 

COMMON/ SMACK/ A1  < 5S5 1 , A2 ( 555  » . A3  I 555 1 . B1 ( 1 1 1 > .82 ( 1 1 l > . 
. B3(  111  I.HEAD110I.IREC 

I SN 

ooos 

COMMON/*/  UMAX 

I S N 

0006 

INTFGER  RECS.REPEAO 

I SN 

0007 

DIMENSION  I E AD4  1 0)  . ISTART  I 1 ) , I STOP! 1 1 . I T IME 1 < 31  . IT  I ME2I  3) 

I SN 

oooe 

DIME  NS  I ON  SAVE! 10 1 . RFCS 43 1 

t SN 

0009 

f- 

EQUIVALENCE  I IE  ADI  1 > .HE  AD (1  1 1 

I SO 

00  1 0 

DO  10  J = 1 .3 

I SN 

00  11 

1 0 

REC  SI  J)  =0 

! SN 

00  12 

REREAD=0 

t SN 

001  3 

r 

NE  X T=1 

I SN 

00  l 4 

CALL  HD25EC ( I ST  ART. ION) 

I SN 

001  s 

CALL  HD2SEC4  ISTOP.  ICFF  ) 

I SN 

001  6 

NUMRF  r = (IOTF-ION)/R55+2 

I SN 

0017 

LEN  = ( inrF-IONM  l/!NTFR«-l 

I SN 

oo  i ft 

c 

NRE  C = I RE  C ♦ 1 

I SN 

0019 

20 

c 

CALL  READINRFC.O) 

I SN 

0 0 2 C 

IF ( IE AD  I 1 1 . NE .-101  GO  TO  30 

I ■‘N 

0022 

NRE  C ■=  I REC-1 

T SN 

0023 

GU  TO  20 

f ^C^DItC  P A3 


S BLATOU-iOTVllMliS 


k i 


! bN 

0 0.’ 4 

30 

RFC  S ( 3 ) *«ECS<  2 1 

I 5 N 

01  >« 

PECS  12  ) «RECS I 1 1 

! »N 

oo  ?.t 

REC  SC  1 = I Rf  C 

l SN 

002  7 

IF  ( ( RECSl  1 ) .NE. RECSl  311  .AND.IRECSU  l.NE.PECSI  2)  > 1 GO  Tf)  40 

: sn 

0 0 <*9 

PRINT  12.  RECS  < 1 ) 

1 SN 

00  10 

1 2 

FORNATIl*  .*.«  RECORD  •,I5.»  REREAD  »*»*•> 

! SN 

00  1 1 

RE  RE"  AD  = RE  READ*  1 

1 SN 

0 0 3? 

IF ( RtRfcAO.LT .6 ) GO  TC  40 

I Sn 

0 0 3 4 

PRINT  13 

1 SN 

00  55 

1 3 

FORMAT  (IX.*  ****  PE  RE  AO  THRESHOLO  PEACHECI  EXEC  TERMINATED 

I SN 

00  IS 

c 

STOP 

I SM 

00  3 7 

40 

CALI.  HDCONVIITlMFl.il 

! SN 

0038 

CALL  HD2SECI 1TIME1.ITII 

I SN 

0039 

I ON  1 = I T 1*555 

! SN 

004  0 

IF ( ( I ON.GE. 1 T1 1 .AND. ( ION.LE . IONI 1 » GO  TO  100 

l SN 

004  2 

I S=I0N-IT1 

1 SN 

004  3 

I AlHJM  S I GN(  1 . IS  » 

t )N 

0044 

I S=I ABSI I Sl/555 

t SN 

004  5 

IF  ( IS. EQ .01  IS=1 

! SN 

004  7 

NPFC  = l RE  C ♦ I A 00  * IS 

I SN 

004  e 

I F ( NREC .GT. 0 1 GO  TO  20 

I SN 

ooso 

PRINT  85 

I SN 

00  5! 

85 

FORMAT  I IX •’  4*4  WARNING;  BEGINNING  OF  TAPE  ***•> 

1 SN 

0 0 52 

N RE  C =1 

r sn 

005  3 

GO  TO  TO 

! Sn 

0054 

100 

I REC.l  -NRF  C 

1 Sn 

0055 

DO  110  J = 1 . 1 0 

I SN 

0056 

IF ( ( J. EQ. 71  .OR . { J .EC  .10  1 1 GO  TO  108 

1 SN 

005  8 

SAVE! J1=I EAOt Jl 

1 SN 

0059 

GO  TO  110 

ISN 

0060 

108 

SAVE ( J) =HEAD( J I 

I SN 

006  1 

1 1 0 
c 

C ONTI NUE 

I SN 

0062 

I STE  P = I NTER/5 

I SN 

0063 

I BEGcI  I ON-T  T1  1/  INTER* IS TCP 

I SN 

0064 

IEND=1 1 1 

t SN 

0065 

OO  250  K=1,NUMREC 

I SN 

0066 

DU  200  Jl  =1  BEG.  IEND,  I STEP 

I SN 

0067 

1C  = Jl 

I SN 

0 0 6 B 

CHI  ( NEXT) =01  I Jl  1 

I SN 

0069 

CH2 ( NEXT) =B2(J1 1 

I SN 

0070 

CH  3 < NEXT  1 =03  < Jl  1 

I SN 

0071 

N£  X T tNE  XT*1 

I SN 

0072 

IFINEXT.LE.5550  1 GO  TO  195 

I SN 

0074 

PRINT  150 

I SN 

0075 

150 

FORMAT ( 1 X ,•••■  FINDS  DESIRED  SCAN  EXCEEDS  DIMENSION  •**•./) 

I SN 

0076 

GO  TO  255 

I SN 

0077 

195 

IF  ( NEXT. GT .LEN 1 GO  TO  255 

I SN 

0 07  9 

200 

C ON T I NOE 

I SN 

0060 

IF ( K .EQ.NUMREC 1 GO  TO  255 

I SN 

0082 

NREC  =1  P£C*1 

I SN 

0083 

CALL  READINREC.O) 

! SN 

0084 

?01 

CONT I NUE 

l SN 

0085 

IOEG=I STEP- IE NO* I C 

! SN 

0086 

2 50 

/• 

CONT INUE 

r sn 

0087 

255 

IREC2=I F AD( 1 1 

I SN 

0080 

l XMA  X = NTXT-1 

I SN 

0009 

IE AD( 1 1 =S  AVE ( 1 ) 

I SN 

0090 

I F ADI  2 1 =S AVE  ( 2 1 

I SN 

009  1 

CALI.  HOCONVI  I ST  APT, -1  1 

I SN 

0092. 

I E AO  I fl  ) =S  A VE  1 H 1 

I SN 

009  3 

I E AD  I 91 =S AVE  ( 9 1 

r sn 

0094 

HE  ADI  10 ) =SAVEI  1 0 1 

I SM 

0095 

PRINT  40P.IREC1 . IREC2.IXMAX.ltSTART<KI,K=1.5>.< ISTOPOO  .K  = 1 

1 SN 

0096 

800 

Form  AT < 1 X , • ST AR T RECORP  = * . I 4, • , STOP  PE  CORD  = • ,!♦,',  *.17, 
.•  DATA  PO INTS * . /. 1 X . » ST  ART  T I ME= • . I 4 . • / » , I 3 . * / * 1 1 2 • • ’ * i 
. 12  . * ; • . 12  .' . STOP  T IME  = * . 14  .•/•  . 13.  •/• . I 2. • : • . I 2.  • : 12. /* 

I SN 

0097 

return 

r sn 

0096 

END 

43 


NAME  - - FLTAD J 
TYPE  - - FILTER 
SOURCE--D.  CHESLEY 


PURPOSE--  Adjusts  start  and  stop  times  so  desired  span  is  still 


present  after  the  data  have  been  filtered  with  DOFILT. 


DESCRIPTION- -CALL  FLTAD J (IL,  ISRT,  ISTP) 

IL  - length  of  array  containing  filter  coefficients  is  2*1 L+l 
ISRT  - (dimension  = 5,  integer)  contains  year,  day,  hour, 

minute,  second  of  desired  start  time  after  filtering 
ISTP  - (dimension  = 5,  integer)  contains  desired  stop  time 
after  filtering 


FLTADJ  changes  ISRT  and  ISTP  so  that  more  data  than  desired  will 
be  read  from  the  tape.  Subsequent  filtering  with  DOFILT 
will  reduce  the  data  scan  to  the  desired  length. 


ISN  00  02 
I SN  OCO  3 
1SN  0004 
I SN  0005 
TSN  OCOt, 
I S N 0 o 0 r 
T SN  0009 
l SN  0O 09 
I SN  0010 

i sn  oou 

1 SN  0012 


SUBROUTINE  FLTAOJI IL. ISRT. ISTP) 
DIMENSION  I SRT  ( 1 ) , ISTPI  1 | 

I N -I 

CALL  H02SFF ( ISRT  , IS  ) 

I S-I S- I L*  I N 
C Alt  S E 0 2 HD  { I S , ISRT  ) 

CALL  HD2Sfc'C(  ISTP,  IT  I 

1 T -I T* I L»I N 

CALL  SEC2HDI IT, ISTP) 

RE  TURN 
END 


r 


NAME-- HAM ING 


TYPE--F1LTER 


SOURCE--  U.  CHESLEY 


PURPOSE--  Places  a Hamming  window  on  filter  coefficients  calculated 
by  HPF1LT,  LPFILT,  or  BPF1LT. 


DESCRIPT  ION- -CALL  HAMING  (W , N) 

W - the  array  (real, single  precision)  containing  filter 
coefficients  to  be  modified  by  HAMING, 

N - the  length  of  W Is  2*N+1 

The  Hamming  window  has  a very  sharp  cutoff  (60  db/octavo). 


The  coefficients  are  calculated  as: 


W(I)  - W(I)  x 0.54  + 0.46  c 


I (-N+I-1) 

08  [_^S LJ  ' 


I - 1.2N+1. 


1 Sn  0002 


I 6N  0 00  3 
ISN  0 004 
1 SN  0005 
1 SN  0006 
ISN  0 00? 
ISN  0 004 
ISN  0 009 


SUBROUTINE  HAMING(W.N) 

FOR  WEIGHTS  WITH  HAMMING  WINPOW 
CALL  hofilt  FIRST 
D I ME  NS  1 ON  W (1  ) 

PI  *3.141  592  6536 
N M A X = 2 * N+  1 
DO  10  1=1. NMA* 

W(  1 ) =(0. 54+  0.46*COS< ( -N+ I -1  )*PI/N»)*W  ( I J 

RETURN 

END 


PRECEDING  PAGE  BLANK-GOT  FIUeE 
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NAME- -HDCONV 
TYPE--UTILITY 
SOURCE--D.  CHESLEY 


PURPOSE--  converts  time  array  to  header  array  or  vice  versa. 


DESCRIPTI ON - - CALL  HDCONV  ( I HEAD , NUM) 

IHEAD-  (dimension  ■=  5,  integer)  contains  or  will  contain 
year,  day,  hour,  minute,  second 
NUM  = +1  for  loading  IHEAD 


= -1  for  loading  header  array 
COMMON --/ SMACK/  contains  the  header  array. 


NOTES:  The  header  array  HE AD (10)  is  used  to  carry  start  times 

from  subroutine  to  subroutine,  but  user-supplied  times  are 
in  arrays  such  as  IHEAD  (ISTOP,  ISTART  in  FIND).  HDCONV 
is  used  to  change  one  type  of  array  into  the  other. 


! SN 

0002 

SUBROUTINE  HDCONVi IHE AO. MOM) 

I SN 

0003 

COMMON/ SMACK/ A l ( 555  1 . A 2 ( 555 ) . A3( 5 55 > . 0 1 ( 1 l 1 1 . 8 21  l 1 1 
. B3  I 1 1 1 1 .HE  Al)  ( 1 0 1 , 1REC 

1 1 . 

i SN 

0004 

DIMENSION  IEAOI 10) . IHEACH 1 ) 

I SN 

0005 

EQUIVALENCE  ( 1 E AD ( 1 > , HE  AO  C 1 1 1 

l SN 

0006 

IF  (NUM.EQ.-ll  GO  TO  50 

T SN 

oooe 

00  10  J~  1 . 4 

r SN 

0009 

1 0 

IHEAOI  Jl  -1 E A D ( J +2 1 

I SN 

00  1 0 

l ME AD(  5)  =HE AO<  7 ) 

I SN 

00  11 

c 

GO  TO  100 

t SN 

0012 

50 

DO  75  J = 1 .4 

I SN 

001  3 

75 

IE.AD  ( J *2  1 = 1 HE  A D ( J 1 

f SN 

00  t 4 

HE  AD<  7 1 -I HEADiS 1 

I SN 

0015 

1 00 

RE  T URN 

1 SN 

00  1 6 

END 
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NAME- -HD2SEC 


TYPE--UTI LI TY 


SOURCE--D.  CHESLEY 


PURPOSE--converts  start  and  stop  times  tt  seconds  since  1968 

ignoring  leap  years  (and  1-sec  WW V (end  of  the  year)  corrections). 


DESCRIPTION--  CALL  HD2SEC  (IA,  IB) 


IA  - (dimension  » 5,  Integer)  contains  year,  day,  hour, 
minute,  second,  and  is  not  changed  by  HD2SEC 
IB  - returned  value  (integer)  in  seconds  since  1968. 


NOTES --SEC2HD  performs  the  opposite  function. 


SUBROUTINE  HD2S  E C I I A , I 8 > 
DIMENSION  I A I 1 ) 

I B= ( IA<  l >-196  8) *365*24*3600 

1 B=l  B+  I A<  21*24*3600 

IB= IB* I A<  3> *360  0* IA<  4 >*60* I AI5) 

RETURN 

END 


I SN  0002 
ISN  0003 
ISN  0004 
ISN  0005 
ISN  0006 
ISN  0007 
ISN  0008 


NAME  - -H PF  XLT 


TYPE--FI  LTER 
SOURCE--D.  CHESLEY 


PURPOSE--  Generates  coefficients  for  a high-pass  filter  to  be 
applied  by  DOFILT. 


DESCRIPTION--CALL  HPFILT  (W , N,  DLT , HPFREQ) 

W - an  array  of  2*N+1  points  which  contains  the  calculated 
coefficients 

N - 2*N+1  is  the  number  of  coefficients  (£1000) 

DLT  -digitizing  interval  of  data  to  be  filtered 
HPFREQ  - the  desired  high-pass  corner  frequency  (Hz) 


COMMON --/ F ILT / contains  data  for  PLT1  labels. 


I r»N 

00  OP 

SUBROUTINE  MPMIT  <W  . N.  OUT  . HPFREQ! 

I SN 

COO  1 

COMMON/r  Il_l/F1LAB<2».  SPER.  XLPER 

I sr j 

0 00  0 

0 IMF  NS  ION  XI.  AB<2> 

c 

W IS  ARRAY  OF  2 N + l POINTS 

c 

N IS  NUMBER  OF  OATA  POINTS  EACH  SIDE 

I r»n 

ooo'. 

c 

OIMF  NSION  Will 

l s n 

0006 

OATA  XLAS/'HP  F'.'ILT  •/ 

( sr: 

0 00  7 

fllAPIl  l-KLAflll) 

! SN 

COOP 

F I L A B ( 2 ) = XI  AB  ( 2 ) 

I jN 

000'? 

SPER-l./HPf REQ 

I SN 

00  1 0 

PI  =3.1)1 5926536 

1 SN 

00  11 

C ON- OL  T * Hf’F  RFQ 

I S N 

00  1 2 

DO  10  I = 1 ,N 

I ;n 

00  1 3 

OI-Nil-l  ) ♦ P 1 * CON  ♦ 2 • 

I f '.N 

00  1 a 

Will  -*2« "C  ON 

I SN 

00  15 

ir<X.NE.OI  W(  I )=¥»  1 1 *SINCX)/X 

1 SN 

001  7 

W ( 2 • N-  I ♦ 2 ) = W ( I I 

i r-N 

00  1 8 

KIN*  1 I = 1 . -2. * CON 

I SN 

00  1 9 

10 

C ONT  1 NUt 

I SN 

0020 

Rh TURN 

t SN 

002  1 

E NO 

tytfT. 


NAME--  INFILT 
TYPE- -FILTER 


SOURCE--D.  CHESLEY 

PURPOSE--Generates  coefficients  for  a filter  that  (when  applied 
to  data  by  DOFILT)  generates  original  ground  motion  by 
deconvolving  the  instrument  response  from  the  seismic  data. 

DESCRIPTION --CALL  INFILT  (ICH,  W,  N,  Nl,  N2) 

ICH  - channel  number  of  data  that  will  be  filtered 
1 = Z , 2 = N-S  , 3 * E-W 

W - array  of  length  2*N+l  that  contains  the  calculated 
coefficients 

N - 2*N+1  is  the  number  of  coefficients 

Nl  - desired  first  nonzero  Fourier  coefficient 

N2  - desired  last  nonzero  Fourier  coefficeint 

NOTES -- INF ILT  reads  256  Fourier  coefficients  of  each  of  three 
instrument  response  curves  (Z,  NS,  EW)  from  a disk  file 
(no.  14  in  JCL).  It  then  sets  data  points  1 to  Nl-landN2+l 
to  256  equal  to  zero,  takes  the  inverse  FFT , and  stores 
the  real  part  of  the  result  in  array  W backward  in  positions 
W(258)  to  W(513).  It  sets  the  remaining  values  in  W to 
zero.  DOFILT  then  uses  this  array  as  a filter  in  the  stan- 


i 
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I SN 

0002 

Subroutine  infilti km.u.k.k  ,k? 

I SN 

0003 

COMPLF  K 01  ( 2 561 , 02  < 2S6  1 .O  3<  ;'56  1 

1 SN 

0004 

D I ME  NS  I ON  W<1» 

I SN 

0006 

NT  WO  =8 

1 SN 

0006 

PF  AO(  141  01.02.03 

I SN 

ooor 

OFwIhO  14 

I SN 

oooe 

DO  S J =1  .256 

I SN 

0009 

GO  Tp  (2.3.41.  I C H 

l SN 

001  0 

2 

01  ( J)  = 1 . /01 ( J 1 

I SN 

0011 

GO  TO  5 

I SN 

0012 

3 

D1  < J 1 =1  ./D2( J > 

I SN 

001  3 

GO  TO  5 

t SN 

001  4 

4 

D1(J)=1./D3(JI 

I SN 

001  5 

5 

CONTINUE 

I SN 

0016 

IF (N1 .EO.l 1 GO  TO  10 

I SN 

001  « 

N3  -Nl-1 

l SN 

001  0 

on  1 0 .1  = 1 » N3 

I SN 

0020 

J1  =N—  J ♦ 1 

l SN 

0021 

01  ( J) -CP PL  X ( 0 ..0.1 

1 SN 

0022 

D1  ( J1  1 =C  MPL  X(  0 . . 0 . 1 

I SN 

002  3 

1 0 

CPNT I NUE 

I SN 

0 02  4 

N4  =N2  F 1 

I SN 

0025 

N5=N-N2 

I SN 

0026 

DP  20  J=N4.N5 

l SN 

0027 

20 

0 1 ( J 1 = C MPL  X ( 0 . .0 . 1 

I SN 

0028 

CALL  F ASTO( D1 .NTWC.l 1 

I SN 

002? 

00  30  J=1.256 

t SN 

0030 

J1  =51 3- J« 1 

l SN 

0031 

*<  J1  1 = RE  AL  ( 01  ( J 1 1 

t SN 

0032 

30 

CONT I NUE 

I SN 

0033 

DO  40  J=1 .2 57 

I SN 

0034 

40 

w < ji =0. 

I SN 

00  35 

RE  TURN 

I SN 

0036 

END 

? 


NAME  - -KREAD 
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TYPE- - 1 0 

SOURCE- -KARL  HINCK 


PU RPOS E - - R e ad s 7TRK  data  tapes  backward  or  forward  1 record  and 
returns  appropriate  error  codes  in  case  of  read  errors. 
Called  only  by  READ  and  data  must  be  interpreted  by  READ. 

DESCR1PTI0N--CALL  KREAD  (AREA,  NBYTES) 

AREA  - dimensioned  greater  than  the  length  of  a block  on 
the  tape 

NBYTES  - number  of  bytes  read.  Set  to  -40000  if  EOF  is 
encountered.  Set  to  -50000  for  a read  error.  An 
error  message  is  placed  in  the  first  50  bytes  of  AREA 
CALL  KRDBK  (AREA (LAST) , NBYTES) 

AREA  (LAST)  is  the  end  of  array  AREA 
NBYTES  - returns  0 if  correct 
CALL  KREAD  reads  next  record  on  tape 


CALL  KRDBK  backspaces  tape  one  record. 


V 


■aom 
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kread  csect 
* 


* KREAD  IS  CALLED  FROM  A FORTRAN  PROGRAM  AS:  CALL  KRE  AD ( ARC  A , N©V  Tt  S ) • • • 

* AREA  MU  9 T BE  ->  BL  KS  17  6.  MBYTES  18  THD  NUMBER  OF  BYTES  RE AO  IN.... 

* for  end  or  file  nbytes  is  set  to  -40000.  for  a rcad  error  it  is  setto 

* -50000  AND  AN  ERROR  ME S SAGE  IS  PLACED  IN  THE  FIRST  50  BYTES  OF  APE 4. • 

* TO  BACKSPACE:  CALL  KPDBKC  AREA (LAST),  MBYTES ) . HERE  THE  T ST  A RG.  MUST 

* BE  THE  END  OF  THE  ARRAY  AMD  NBYTES  IS  0 IF  O.K.<< 

* AFtER  THE  END  OF  DATA  IS  INDICATED,  CALLING  KREAD  AGAIN  WILL  START  AT 
» THE  8 EC l NN I NO  AGAIN...  ONLY  TAPES  CAN  BE  READ  BACKWARDS.  ANYTHINO 

* ELSE  WILL  BE  READ  FORWARDS- 


* HI  G 

* 


KROBK 

SAVE 


OPEN 


WOPEN 

CALC 


BACK 


SA 

SW1 
ADOR 
ARDBk 
' NTAPE 
ENDft 


TAPE Rfc 


DEPT  OF  GEOPHYSICS KARL  H1NCK-...  15MAT74 

USING  KREA0.I5 
MVC  SW  I . AOOR 
SAL  15,  SAVE 
USING  T , > 5 
MVC  SW1  .ARDBK 
SAVE  (14.12) 

DROP  15 
USING  KRDBK.4 
LR  A. IS 
LA  2, S A 

ST  2,6(13) 

ST  J3.SA.A 

LR  13,2 
L 2.SW1 

OR  2 

LR  3,1 
La  2. WOpEN 
ST  2 . AOOR 

OPEN  INTAPE 
LR  1.3 
LM  2,3, 0(1) 

READ  CHKT, SF, INTAPE, 12) , 'S ’ 

CHECK  CHKT 
C 2, -F ' -50000* 

BE  BACK 

L 2 • I NT  APE+  6 8 

LH  2. 22C  2) 

LNR  2.2 
AH  2 . I NT  APE  + 62 
ST  2,0(3) 

L 13.SA+A 

RETURN  ( 14  . 12)  ,T  ,RC=0 
DS  1 6F 

DS  F 
DC  A ( DPE  N ) 

DC  ACREADBK) 

DC  B DSORG=PS  .MACRF- (R  ) . EODAD=ENDR  .DDNAME  =■  I NTAPE  , S YNAD=TAPER» 

L 2 , -F*  -40000  ' 

CLOSE  fNT  APE 
LA  1 .OPEN 
ST  1 , AOOR 

0 BACK" 

SYNADAF  ACSMETHsBSAH 

ST  14.R14S 

MVC  0 ( 50  , 2),  75(1  ) 


R14S 

A 

RE  AD  BK 


I 

| 

H 


L 2, ~F ’ -EOOOO' 

SYNA0RL5 
L l A , Pi  4 S 

14 

OS  F 


ENTRY 

LM 

READ 

CHECK 

8 

END 


krdbr 

2.3,011) 

CHKTBK>SB» 

CHKT8K 

CALC 


TNTAP£.12)» 
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NAME-  - LPFILT 
TYPE-  KILTER 
SOURCE  -0.  CHESLEY 


PU  R POS  FI  - -c  a 1 c u l a t e s low-pass  filter  coefficients  for  use  by 
DO KILT . 


DESK.  R l PT  1.  ON  - - CALL  LPFILT  (W  , N,  DLT,  BPFREQ) 

W - array  containing  calculated  filter  coefficients 
N - length  of  W Is  2*N4l  (slOOO) 

DLT  - digitizing  Interval  of  array  to  be  filtered 
BPFREQ  - low  pass  corner  frequency  (Hz) 


COMMON /F T LT / c on t a 1 n s data  for  PLT1  labels. 


SN 

0002 

SUB  ROUT  INI.  LPF  ILT(W.  N,  DLT  . BPF  RED  1 

SM 

000  1 

C OMMUN/1  I 1.1  21  I L 1-  R<  l > ,SPtN  . XL  PER 

SI  1 

0 p t)  <i 

0 1 Ml  NS  1 ( fj  XI  AH  ( 2 > 

:.m 

C 0 0 s 

D 1 Mf  MC  1 UM  Will 

Mi 

C(  0 A 

0 A r A HUH/'LP  F'.MI  1 '2 

S N 

coo  r 

r 11  AR(  11  XI  A(l<  1 ) 

■ n 

OO'iH 

F 1 1 AIU  2 1 XL  AH  ( ? ) 

• ■ j 

0 0 0 9 

XI  PEP  1./13PFP.EQ 

Ml 

00  I 0 

PI  A.  1 A 1 i.926*j  50 

: • M 

0 0 1 1 

CON  OLT*UPfPtO 

s h 

0 0 12 

DO  1 0 1 1 .N 

x n 

ooid 

x 1 -Mi  1 1 ) * PI *CON*2 . 

Ml 

0 0 1 A 

W(  1 ) - ?.  *C  ON 

' M 

0 0 I 5 

w ( 1 ) W 1 1 ) *s  1 N ( A ) /x 

r.N 

0010 

W <?*  N-  1 f2  ) - W < 1 1 

Ml 

ooi  r 

10  CON  11  NOE 

",  N 

00  1 A 

WIN*  1 ) “2.  *CON 

N 

00  19 

HE  TURN 

SN 

©0P0 

END 
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NAME- -MAXMIN 

TYPE--UTIL1TY 

S Oil RCE  - - D . CHESLEY 


PURPOSE--finds  the  location  and  value  of  maximum  and  minimum 
in  an  array. 


DESCRIP 'PION--CALL  MAXMIN  (A,  N,  AMAX  , MAX.],  AMIN,  MINJ) 

A - array  to  be  scanned  (real,  single  precision) 

N - length  of  A 

AMAX  (AMIN)  - returned  maximum  (minimum)  value  in  A 
MAXJ  (MINJ)  - returned  data  point  number  of  maximum 
(min  tmum) 


1 SN 

000? 

SUBROUT  1 NE  MAXMINIA, 

N. 

AMAX.MAXJa  am  I N . M I N J I 

1 SN 

000  1 

0 1 MF  NS  1 ON  A 1 1 1 

1 SN 

0Q04 

AMAX  =-9999099 . 

I SN 

O00N 

AMI N =9999999# 

1 SN 

oooo 

DO  100  J *1  . N 

I SN 

O00  7 

IF(A( JI.LE. »MAAI 

GO 

TO 

50 

1 SN 

oooy 

M A X J = J 

1 SN 

00  10 

AM 4X=A ( J 1 

I SN 

30  11 

50 

I F ( A(  J)  . GE  . AMI  N ) 

GO 

TO 

100 

r sn 

0"  1 3 

MI NJ= J 

1 SN 

oo  i a 

AM  I N = A 1 J) 

1 SN 

001  5 

1 00 

CONTI NUE 

I SN 

00  1 6 

RE  TURN 

I SN 

001  7 

END 

?A3S  BLANK-.  iOT  ?ILm£5 


Tm-T 
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NAME  - - PLOTB 
TYPE--10 

SOURCE--D.  CHESLEY 

PURPOSE--Plots  B-channel  seismic  data  with  an  arbitrary  (but 
multiple  of  5)  number  of  seconds  between  data  points. 

DESCRIPTION --CALL  PLOTB  (Z,  SCALE,  HITE,  ZMAX , ZMIN,  LKZ  , ISPIK, 
LAB,  INTER) 

Z through  LAB  - identical  to  arguments  for  PLT1 
INTER  - spacing  between  data  points  in  seconds  (must  be 
multiple  of  5) 


NOTES--  Operates  exactly  the  same  as  PLT1  except  that  INTER 
must  be  specified. 


1SN  0002  SUBROUTINE  PL T 0 I Z . S C ALE , H I T£ . 2MAX . ZMI N , L KZ . 1 9P I K ,L A B. I NTE» ) 

I SN  0 00  3 COMMON /SMACK/  A I <6  55  1 . *2  <55*1  ) , A3  (555  >,R1(111).B2(111), 

.03(111)  « H F A r ( l 0 » , IREC 

I SN  0004  COMMON/PL  TPAR /XOFF  , YOFF  ,H1  ,F)2 

I SN  0005  CUMMON/X/ 1XMAX 

I SN  0 0(6  COMMfJN/SP  I K.E  /SPI  Kl  ( 50  0 > .SP  I (C2  1 50  0 » . SP  IK3  (50  0 » . I CNT  1.ICNT2.ICNT3 

ISN  0 C 0 7 CCMMON/ANC.L  E/ANC,,GA  IN 

I SN  000  R 0 1 ME  NS  I ON  I E AD  ( 1 0 1 . Z ( 1 1 

I SN  0C09  DIMENSION  X I 5 55 0 I , Y C 553 O > 

I SN  0010  LOG  I CAl_*4  IIHR/*:00  */ 

UN  0C1I  EOUI  VALENCE  (H£AO<t  li  IEtO(l  II 

I 1 N 0012  KKL-LKZ 

I c n 001  3 YM AX  = Z MAX 

I SN  0014  Y MI  N -Z  MIN 

I SN  0015  XMA  X =1 XMA  X 

I SN  0016  PPM=fcP. /INTER 

I SN  0017  XLE N=XMAX»SC ALE/ (2 .54*PPM > 

I SN  0018  XXl_EN=XLF  N«-XOFF 

ISN  0019  XSC AL= XLEN/XMAX 

ISN  0020  I f ( 7 MA X .Nl  . 7MI N 1 GO  TO  301 

C 

C FIND  MAXIMUM  AND  MINIMUM  VALUES  IN  ARRAY 

C 

ISN  0022  YMAX=-99999. 

ISN  0023  YM | N =9  99°  9. 

ISN  002*  DO  300  J=1,IXMAX 

ISN  0025  Y MAX =AM4Xl ( Z( J) .YMAX J 

ISN  0026  YMI N-AMI Nl I Z( J1 .YMI N> 

ISN  002"’  300  CONTINUE 

ISN  Or? 0 PRINT  299 , YMI N, YMAX 

ISN  0029  299  FORMAT  I 1HO, »PLT1 ! MINIMUM*  • . FQ . 2 . 3 X . • MA X I mum*  «.f9.2//» 


C 

C SCALE  PL  CT  AND  GENERATE  ARRAYS  TO  BE  PLOTTED 

C 
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I SN 

0031 

YYMAX  =Y  MA  X 

I SN 

0032 

YMA  X =YMAX— YMI  N 

I SN 

0033 

YMI N=0 . 

I SN 

00  3 4 

YSCAl =HITE/YM4X 

I Sf, 

00  35 

ymean  = ymax«yscal/2.-*-yoff 

I SN 

0036 

DO  500  J = 1 t IXMAX 

I SN 

0037 

X<  J)  =(  J-l  >*XSCAL*XOFF 

I SN 

0030 

V ( J) = YSCAL* (ZI J 1-YYMIN » + YOFF 

1 SN 

0039 

500 

r 

CONTINUE 

V. 

c 

£ 

PI  OT  Y VS.  X 

I SN 

0040 

501 

CONTINUE 

1 SN 

0041 

CALL  PLOT (X ( 1 ) , Y ( 1 ) ,3  ) 

I SN 

0042 

PO  510  J=2, IXMAX 

I SN 

004? 

510 

CALL  PLOT <X( J)  . Y( J 1 , 2 ) 

I SN 

0044 

CALL  PLOT (XXLEN.YMEAN.3 > 

I SN 

0 04  5 

c 

CALL  PLCT < XOEF, YME AN. 2 ) 



— — 

C 

r 

PLOT  AND  LABEL  ONE  TICK  MARK  EVERY  3 

I SN 

0046 

V. 

IHP  = IE ADI  5) 

I SN 

0047 

REM=HF  A C ( 7) 

I SN 

0040 

XS=( 60. -R EM >*XSCAL* PPM/60 .+XOFF 

I SN 

0049 

' 

NMI N=XMAX/PPM 

I SN 

0050 

NMI N=NMIN*1 

I SN 

0051 

XI NCR=XSCAL*PPM 

I SN 

0052 

UME  A N = YME AN*. 125  ~ 

I SN 

0053 

BME  A N=U  ME  AN— 0 .2  5 

I SN 

0054 

Y Y =B ME  AN-.l 

I SN 

0055 

MI N=I EAD( 6) 

1 SN 

0056 

c 

XMI NS=0 .0 

l SN 

0057 

DO  600  J = 1 . NM I N 

I SN 

0050 

K = J-l 

I SN 

0 05  0 

XMI N=XS+X I NCR*K 

I SN 

0060 

IF( MIN. EO. 591  GO  TO  520 

I SN 

0062 

IF ( ( XMIN-XMINS) .GE. (3 ./2.57J » GO  TO  520 

I SN 

0064 

MI N=MI N+l 

I SN 

0065 

GO  TO  600 

ISM 

0066 

£ 

520 

XMINS=XMI N 

I SN 

0 06  7 

IF(  XMIN.GT.XXLEM  GC  TO  600 

I SN 

0069 

CALL  PLOT (XMI N.UMEAN.3  ) 

TSN 

0070 

CALL  PLOT (XMTN.BMEAN. 2) 

I SN 

0071 

X X = X M I N-.05 

I SN 

007? 

MI  n = MI  N-fl 

ISM 

0073 

I F ( M I N . NE .60)  GO  TO  5S0 

! SN 

0075 

IHR= IHR61 

I SN 

0076 

1 F ( I HR .E0.24 ) I HR  = 0 

I SN 

0070 

XXX=XX-.l 8 

I SN 

0079 

X 1 HR  = I HR 

ISN 

0080 

CALL  NUMBFR ( XXX.YY.H1  .XIHB.0.,-1) 

1 SN 

00P1 

CALL  SYMBOLIXX.YY.Hl  , IIHR.0..3 > 

I SN 

00P2 

MI  N = 0 

I SN 

0003 

GO  TO  600 

I SM 

0084 

550 

W M I N = M I N 

I SN 

0005 

CALL  NUMBER  ( XX  . YY  . HI  . WM  IN  .0  . .-1  > 

I SN 

0006 

600 

CONT INUE 

I SM 

0087 

601 

CONTINUE 

I SN 
I SN 
! SN 
I Sf) 
I SN 
I SN 
I SN 
t $N 
SN 
SN 
I 5I> 
I SN 
I SN 
I Sf 
I SN 


ooefl 

oo°o 

0092 

OOP* 

0096 

0 09  0 

0099 

0100 

01  0? 
01  04 
03  06 
01  07 
0 3 0 6 

0109 

0110 


c 

c 

c 


650 

651 


C 

c 

c 


PLOT  *«S  AT  LOCATIONS  WHERE  SPIKES  WERE  PEMOVEO 

IF( I SPI K.EO.O ) GC  TC  675 
1F( ISPIK.EO.l ) ICNT=ICNT1 
I F ( I SPI K. EQ.2 ) ICNT=ICNT2 
I F( I SPI K.E0.3 ) ICNT=ICNT3 
IF( I CNT.EC.O ) GO  TO  675 
OT  650  1=1 . TCNT 

11  = 1 CNT-I  M 

1F<  ISPIK.EO.l  ) W = (SPIK1  (III  — 1 ) * X SCAL 
IF < 3 SPI K.EQ.2 ) W=(SPIK2 (I  1 1-1  )*XSCAL 
I F ( I SPI K.EO. 3 ) W=( SPI K 3< I 1 )-l  > *XSCAL 

W = W«-XOFF 
YH  I TE  =H  I T Ef-  Y OFF 

CALL  SYMBOL  <W , VHITE  *Hl  , 1 1 .0..-1  > 

CONTINUE 
CONT I NUE 

PLOT  HEADER  INFO 
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I SN 

0111 

675 

C ONT  I NUF 

I SN 

0 112 

XL  ^ 1 . 5 

! SN 

0113 

YL  =0.07 

T c;  (\i 

0 116 

1F(IEAD(2>.ECI.22)  GO  TO  700 

I SN 

0116 

I F ( I F AO ( 2 > .EQ .25 > GO  TO  701 

! SN 

one 

IF ( 1FAD12 ) .E0.24 ) GO  TO  702 

r sn 

0120 

IF  ( I CAD<2  ).E"0. 1 ) GO  TO  703 

1 SN 

01  22 

I r ( IFA0(2  I .F0.23)  GO  TO  704 

I SN 

012A 

IF<  IF.AD<2  1.EQ.2  ) GO  TO  705 

! SN 

0126 

1 Fll  EA0(2  > .EO. 4 ) GO  TO  706 

I SN 

01  28 

PAINT  699 .1  EMM?) 

I SN 

0129 

699 

FORMAT  ( 1 X .• ST  AT  ICN  l.D.  NC.  IS:  • . 1 S » 

! SN 

0130 

GO  TO  725 

I SN 

0 13  1 

700 

CALL  SYNHOL ( XL . YL .H2 , • ST AT  ION!  (221 

K IP 

1 SN 

01  32 

GO  TO  725 

I SN 

0 133 

701 

CALL  SYMBOL ( XL . YL . H2 . ‘ STA T ICN:  (25) 

MAT 

I SN 

0 136 

Ci  0 TO  725 

I SN 

0 135 

7C2 

CALL  SYMBOL ( XL .YL.H2, 'STAT ION!  (24) 

ZLP 

7 SN 

0 1 36 

GO  TO  725 

I SN' 

0137 

703 

CALL  SYMBOL ( XL .YL.H2 ,• STATI ON:  (01) 

C T A 

1 SN 

0 1 38 

GO  TO  725 

1 SN 

0139 

706 

CALL  SYMBOL ( XL  . YL .H2  . • ST AT  ICN:  (23) 

ALQ 

I SN 

0160 

GO  TO  725 

I SN 

0161 

705 

CALL  SYMBOL  ( XL  . YL  ,H2.  ► STA  T ION.*  (0?) 

CHC 

I SN 

0162 

GO  TO  725 

I SN 

0163 

706 

CALL  SYMBOL  ( XL  . YL,  H2  . * ST  AT  ION-.  (06) 

TLO 

T SN 

0 164 

72  5 

XL  = XL» 1 9. *6.  + H2/7. 

I SN 

01  65 

726 

CONTINUE 

1 SN 

0 146 

CALL  SYMBOL ( XL , YL. H2 . • CH!  • . 0. . 3 I 

I SN 

016  7 

XL=XL+3.*6.*H?/7. 

I SN 

014  6 

CALL  SYMBOL! XL. YL.H2.KKL. 0, .2 ) 

I SN 

01  4 g 

X I N=I  F AIM  3 ) 

1 SN 

01  50 

P0S=6.»4.»h2/7.fXL 

I SN 

0151 

CALL  NIIMRFR  (POS  . Yi_  • H2  , X IN  .0  ».-l  ) 

I SN 

0152 

CALL  WHERE<RETX,RFTY,RETFAC> 

TSN 

01  53 

PC  S = R FT  X 

I SN 

01  54 

X I N = - 1 F ADI  6 ) 

I sr. 

01  55 

CALL  NUMBER (POS  . YL . H2 ,X IN ,0  .. -1  ) 

I SN 

0156 

CALL  WHFREI PE TX  . PF T Y . RETF AC  ) 

I SN 

015  7 

POS=RETXF6.*H2/7.«2. 

1 SN 

0158 

XI N=IFA0(5J 

I SN 

0159 

CALL  NUMBER ( POS . YL . HP , X IN , 0 ., -1  I 

I SN 

01  6 0 

CALL  WHERE ( RE  TX.RETY, PE  TF  AC) 

I SN 

016  1 

r~ 

POS  =PFT X 

I SN 

0 162 

K- 

I F ( I FAD ( 6 ) . NE .0  ) GO  TO  735 

I SN 

0166 

CALL  SYMBOL! POS  .YL. H2 . I IHR .0. ,4  ) 

I SN 

0165 

POS  = POS FA ,*6.*H2/7. 

I SN 

01  66 

GO  TO  738 

I SN 

0167 

C 735 

CALL  SYMBOL (POS  ,YL ,H2 .1  22  .0 ..-1  ) 

r sm 

016? 

CALL  WHERE ( RETX  . RETY , RETF AC  ) 

I SN 

0169 

POS  =R E TX 

I SN 

01  7C 

X I N = I E AIM  6) 

I SN 

0171 

CALL  NUMBER (POS .YL . H2 . X IN . 0 .. -1  > 

I SN 

0172 

CALL  WHERE(RETX  .RETY.PETFAC  ) 

I SN 

0173 

POS  = PFT  X 

I SN 

0174 

C 738 

1 F { H E A 0 ( 7 ) . NE • 0 . ) GO  TO  740 

I SN 

0 1 76 

CALL  SYMHOL  (POS . YL , F2 . I I HR , 0 . .4  ) 

I S N 

01  77 

On  TO  762 

I SN 

01  78 

C7A0 

CALL  SYMBOL (PQS  .YL. H2 . 1 22 .0  . .-1  ) 

I SN 

01  79 

CALL  WHEPtlRETX .RETV. RETFAC  ) 

! S N 

0 1 80 

PPS=EF.TX 

i SN 

01  6 1 

I 1 N=HEAC{ 7) 

I SN 

018? 

X I N = I r N 

7 SN 

0!  P3 

CALL  NUMBER ( POS . YL . H2 , XI N .0 . .-1  ) 

t SN 

OlfiA 

74  2 

IF(LAP.EQ.O)  GO  TO  750 

c 

C 

f 

LABEL  POTATION  INFO 

1 SN 

01  86 

POS=POS* . 75 

I SN’ 

0 1 87 

C ALL  SYMBOL  (P05  . YL  • H2  • * ANGLf.  : • « 0 . « ) 

I SN 

01  0P 

I PH  t =ANC. 

T SN 

01  89 

X ANG  =ANG 

• .0 . . in  ) 
• .0 . , is  > 
♦ .0 . , in  > 
• .o . . in  i 
• .o . , in  ) 

•tO.,18) 

'.0..18) 


I SN 

01  90 

POS>POS*6.*6. *N2/7 . 

I SN 

0191 

CALC  NUMBER ( POS . YL • H2 • X ANG . 0 •• 1 ) 

I SN 

0192 

CALL  WHERE (AgTX .RET Y.RETFAC ) 

I SN 

01  93 

POS  = RET  X 

I SN 

01  94 

C 

CALL  SYM0  0L<  POS ,YL.H2.*DEG.*.0..4» 

I SN 

01  95 

POS  = P0S  *4 .*6.4  N2/ 7 . 

I SN 

01  96 

CALL  SYMBOL < POS .YL.H2 ,• GA IN  F ACTOR : • . 0 . . 1 2 1 

l SN 

01  97 

P0S=P0S*12.*6.*M2/T. 

I SN 

01  99 

XGA1  N = 0.  AI  N 

I SN 

01  99 

CALL  NUMBER (POS, YL.HS ,XGA IN,0. .4  > 

I SN 

02  0 0 

CALL  WHtRE<RETX,RETY,RETFAC » 

I SN 

l>_  Ol 

POS’RET* 

I SN 

0 20  2 

£ 

CALL  SYMBOL (POS .YL. H2 .• X A3*.0..4> 

c 

f 

PLOT  AND  LABEL  Y-AXIS 

I SN 

02  03 

750 

CONTI NUE 

I SN 

0 2 04 

751 

continue 

I SN 

0205 

HYTE=YM IN«YSCAL 

I SN 

0206 

Y I NCR-Y MAX/5. 

I SN 

02  0 7 

NUMDEC  =-l 

I SN 

0208 

IF ( YINCR.LT. 5. ) NUMOEC  = 2 

I SN 

02  1 0 

DO  800  J=1.6 

I SN 

021  1 

XKO j-1 

I SN 

02  1 2 

YYY-XK*Y| NCR* YSC ALT YOFF 

: SN 

02  13 

Call  plot (o .875  .yy y . 3 > 

I SN 

0214 

CALL  PLOT (1  .1 25  . YYY.2  ) 

I SN 

0215 

XYPOS-YYM I N T Y INCR*XK 

I SN 

021  6 

CALL  NUMBER < 0.6  .YYY. HI  .XYPOS.O. .NUMOECI 

I SN 

02  1 7 

800 

CONTINUE 

I SN 

0 21  B 

YYMI N=  YW I N+YOFF 

I SN 

021  9 

YHI  T£=HI TETYOFF 

I SN 

0220 

CALL  PLOT (1 . .YYMIN.3 * 

I SN 

0221 

CALL  plot  a . . YHITE.2 ) 

I SN 

0222 

CALL  PLOT (0. . YHITE.-3 1 

I SN 

0223 

CALL  PLOT ( 0. . 0. .5 1 

I SN 

0224 

801 

CONT I NUE 

I SN 

0225 

RE  TURN 

I SN 

0226 

END 
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NAME- - PLT  X 
TYPE- -10 

S0URCE--D.  CHESLEY 

Pl)RPOSE--Plots  seismic  data  on  a XYNETICS  plotter.  Labels  each 
plot  with  station  name  and  code,  start  time,  rotation,  and 
filter  information.  Data  points  must  be  one  per  second. 

DESCRIPTION--CALL  PLT1  (Z  , SCALE,  HITE,  ZMAX , ZM1N,  LKZ,  ISPIK, 

LAB) 

Z - the  array  to  be  plotted 
SCALE  - horizontal  scale  in  cm/min 

HITE  - height  of  the  plot  (without  labels)  in  inches 
ZMAX  - maximum  value  of  Y-axis 
ZMIN  - minimum  value  of  Y-axis 

LKZ  - two-character  string  enclosed  in  apostrophes,  used 

to  label  the  channel  that  is  plotted  ('Al',  'A2',  'SM') 

ISPIK  - channel  number  (1,  2,  or  3 for  Al,  A2 , A3  respec- 
tively) causes  asterisks  to  be  plotted  at  each 
location  where  DSPYK  has  removed  a spike.  ISPIK  = 0 
means  no  asterisks  are  plotted. 

LAB  - label  parameter: 

0 - no  rotation  and  no  filter 

1 - rotation  but  no  filter 

2 - filter  but  no  rotation 

3 - both  filter  and  rotation  information  are  plotted 


in  the  label 


66 


COMMON- - /SMACK/  contains  HEAD(IO),  which  holds  the  start  time 
of  the  trace 

/PLTPAR/  holds  letter  sizes  and  X and  Y offsets  (see  SET) 

/FILT/  contains  filter  information  for  label 

/X/  contains  length  of  2 

/SPIKE/  contains  positions  of  spikes  which  were  removed 
by  DSPYK 

/ANGLE/  contains  rotation  infcrmation  for  label 

NOTES--  PLT1  is  designed  specifically  for  plotting  A-channe 1 

data  at  1 data  point  per  second.  HEAD(l-lO)  contains  the 
start  time.  PLTl  plots  and  labels  minute  marks,  except 
that  PLTl  suppresses  the  marks  if  they  are  less  than  three 
centimeters  from  the  previous  mark,  to  avoid  overcrowding. 
Hour  marks  are  always  plotted.  PLTl  interprets  the  station 
number,  HEAD(2),  if  possible  and  labels  the  plot  with  a 
three-letter  abbreviation.  If  the  station  number  is  not 
decodable  it  is  printed  and  that  portion  of  the  plot  label 
i s deleted.  With  the  appropriate  value  of  LAB,  the  subrou- 
tine includes  rotation  and/or  filter  information  in  the 
label.  The  Y-axis  is  labelled  automatically.  If  the  year 
(IEAD(3))  is  zero  the  time  is  not  plotted.  The  desired 
maximum  and  minimum  values  to  be  plotted  may  be  defined  in 
the  argument  list  (ZMAX , ZMIN)  , and  thus  the  vertical  scale 
is  user-determined . However,  if  ZMAX  ■ ZMIN,  PLTl  scans 
the  array  and  uses  the  maximum  and  minimum  values  in  the 
array  to  define  the  vertical  scale.  In  this  case  the 
maximum  and  minimum  are  printed. 
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The  starting  position  of  the  pen  is  (-XOFF,  -0FF-H2) 
from  the  lower  end  of  the  Y-axis.  The  final  position  is 
(-XOFF,  HITE+H2).  Changes  in  SCALE  and  HITE  will  not 
affect  the  letter  size. 

PLT 1 requires  the  statement  CALL  SETXYN  (or  SETCC) 
prior  to  the  plotting  command  and  the  statement 
CALL  PLOT  (0,  HITE,  999) 

at  the  end  of  the  main  program.  An  output  tape  must  be 
supplied.  See  the  sample  programs  for  JCL  details. 

CALL  PLT1  generates  ones  XYNETICS  drawing. 


I SN 

0002 

SUBROUTINE  PLT  1 (Z .SCALE .H  ITE.ZMAX . ZMIN.LKZ.  ISPI K. CAB) 

I SN 

0003 

COMMON/SMACK/  Al  (555  > . *2  (555  ) . A3  ( 555  ).B1(UI).B2(1U>, 
93(111)  , HE A D ( 10).  IREC 

I f'N 

0004 

C0MM0N/PLTPAR/xaFF,Y0FF,Hl,H2 

I SN 

0005 

C OMMON/F  I LT/F I LAB<  2 ) , SPER. XLPER 

1 SN 

0006 

COMMON/X/ I XMAX 

I SN 

0007 

C OMMGN/SPl KE/SPlKl  (500)  .SPIK2CSOO ) .SPIN  3(500 ) . ICWTl . ICNT2, ICNT3 

T SN 

0008 

common/angle/ang.ga  in 

I SN 

0 C 0 9 

DIMENSION  IE AD(10), Z<»> 

r sn 

00 1 0 

DIMENSION  X ( 5550)  .Y  (6650) 

I SN 

00  1 l 

LOG  I C AL  *4  FILAB 

I SN 

0 012 

logical*4  iihr/>:oo  •/ 

5 SN 

OC  U 

EQUIVALENCE  (HE AO(l  ) ,IE AD(1  ) ) 

I SN 

00  1 4 

WTH-6 . *H2/7 . 

I SN 

0015 

ZERO  -0  . 

I SN 

0016 

KKL  =LKZ 

I SN 

001  7 

YMAX  sZMAX 

I SN 

00  1 8 

Y M I N = Z M I N 

I SN 

0010 

XMAX  = I XMA  X 

I St, 

0020 

XLEN=XMAX*SCALE/ (2 .54 *60.  ) 

I SN 

0021 

XXLE  n = xle  n*  xoff 

I SN 

00  2 2 

X SC  AL- XLEN/XMAX 

I SN 

0023 

C 

c 

f 

I F( z MAX ,NE. ZMI N ) GO  TO  301 

FIND  MAXIMUM  AND  MINIMUM  VALUES  IN  ARRAY 

I SN 

OC  25 

V, 

YMAX=-99999. 

I SN 

0026 

YMI  N *99999. 

I SN 

002  7 

DO  300  J=i  , I XMA  X 

I SN 

0 C 28 

YMAX=AMAX1(Z(  J)  . yma  X ) 

I SN 

0029 

YMIN=AMINl (Z(J).YMIN) 

I SN 

003  0 

300 

CONTI NUE 

I SN 

0031 

PRINT  299 .YMI N. YMAX 

I St, 

0032 

2 99 
C 
C 

FORMAT ( 1H0 ,• PLT1  I MINIMUM:  » , E9 . 3 . 3X . ’ M A X IMUM=  •.E9.3//J 
SCALE  PLOT  AND  GENERATE  ARRAYS  TO  BE  PLOTTED 

I SN 

00  33 

V- 

301 

YYMI  N = Y,NI  N 

I SN 

0034 

Y Y M A X -Y MAX 

I SN 

0035 

YMAXiYMAX-YMI  N 

ISN 

0036 

YM I N =0 . 

I SN 

0037 

YSCAL=HITE/YMAX 

I SN 

0038 

ymean=ymax»vscal/2.*yoff 

I SN 

0039 

Do  500  J = I . I XMA  X 

I SN 

004  0 

XI  J)  -(  J-l  >*XSCAL  *XOFF 

I SN 

0041 

Y(  J)  = Y SCAL* (Z(J)-YYM1N)*Y0FF 

ISN 

004  2 

50  0 

COnT INUE 

6 M 


C 

C PLOT  Y VS.  X 

c 


I SN 

004  3 

501 

CONT I NUE 

1 SN 

0044 

call  plot ixu  i <y(i  I •}) 

I SN 

0 04  6 

Oo  61 0 j- 2 • I XMA X 

I SN 

00  46 

51  0 

CALL  PLOT  (X< Jl  ,Y(J)  .2  ) 

I SN 

004  7 

CALL  PI  OT (T  HL6N i YMEANi 3 1 

I SN 

004  9 

c 

CALL  PLOT  (XOf  F , YME  AN. 2 ) 

V 

c 

c 

PLOT  ANO  LA0EL.  ONE  TICK  MARK  EVERY 

3 CM. 

1 SN 

0049 

I HR-  IE ADI  5) 

I SN 

ooso 

PCM  HE ADI  7 > 

I SN 

ocst 

AS  (60.  -RE  MM  XSCAL+XOFF 

I 'N 

0052 

NM1 N-XMAX/60. 

! ‘ N 

0 0 53 

N Ml  N -NMI  N f 1 

I SN 

00  54 

X I NCR- XSC AL  *60 . 

I SN 

00  55 

UME  AN  = Y ME  AN  «■  . 1 2 5 

I SN 

0056 

8 ME  A N = U ME  AN -0.2 5 

I SN 

0 05  7 

YY  = 0M  E AN“ .1 

1 SN 

0056 

MI N=I EAOI6 1 

I SN 

OOS  9 

/• 

XM 1 NS-0 .0 

I SN 

0060 

V, 

DO  600  J-l . NMIN 

I SN 

0061 

K=  J- J 

I SN 

0062 

XM I N = X S + X INCR  »K 

I SN 

0063 

IE (MIN. EQ  .59 ) GO  TO  520 

I SN 

0 0 65 

1 F I I XMI N-XMI MS ) .GE . ( 3./2 .57  I ) SO  TO  520 

I SN 

0067 

MI  N -M  1 N + 1 

I SN 

0068 

£ 

GO  TO  600 

I SN 

0069 

520 

XM INS- XMI N 

t SN 

00  7 0 

I FI  XMI N.GT. XXLENI  GO  TO  600 

I SN 

00  72 

CALL  PLOT <XMI N.UMEAN.3) 

I SN 

0073 

CALL  PLOT (XMI N . 8MEAN. 2 ) 

l SN 

0074 

X X = X M I N - . 05 

1 SN 

00  75 

MI  N = MINM 

I SN 

0076 

IF ( Ml N. NE .60 ) GO  TO  550 

I SN 

0078 

1 HR  - [ HR ♦ j 

I SN 

0079 

I F ( IMR.E0.24)  I HR  =0 

I SN 

0081 

XXX  = X X — . 1 8 

I SN 

0082 

XI  HR  - I HR 

I SN 

0083 

CALL  NUMBER  I XXX , YY, HI  , X IHR.O. .-1  > 

I SN 

0094 

CALL  SYMBOL  I XX . YY . HI  . I I HR .0 . .3  ) 

I SN 

0085 

M I N = 0 

I SN 

0086 

GO  TO  600 

I SN 

008  7 

550 

WMt  Nr MI  N 

ISN 

0088 

Call  numbf.R(xx.yy.hi  , wn  in  ,o  . .-i  > 

I SN 

0089 

600 

CONT INUE 

I SN 

0 09  0 

601 

/• 

Continue 

V. 

c 

c 

PLOT  »’S  AT  LOCATIONS  W HERB  SPIKES 

MERE.  REMOVED 

ISN 

0091 

V 

IF! I SPIK.EQ.0 ) GO  TO  675 

I SN 

0093 

IF(  ISPIK.EO.l  ) ICNT=ICNTl 

t SN 

0095 

I F(  1 SPl K.EQ.2  ) ICNT=ICNT2 

I SN 

0097 

IF(  ISPI K.E0.3  ) l CNT  * I CN T 3 

I SN 

0099 

I F(  ICNT.E  0.0  ) GO  TO  67S 

I SN 

0101 

00  650  I =1 . I C NT 

I SN 

0102 

I 1 = ICNT  -l  Al 

I SN 

01  03 

I F I l SPI K. E0.1  ) w*( SPIK1  (11  )-l  »*XSCAL 

I SN 

0105 

1FI  ISPIK.EQ.2)  w-(SPtK2(Il)-lI  * XS  CA  L- 

T SN 

0107 

I FI  I SPIK.EO. 3)  M = ( SPIK3 ( I 1 1-1  ) *XSCAL 

I SN 

0109 

¥ =X  + XOFF 

I SN 

Olio 

YHI Tt "HI TE+ YOFF 

I SN 

on  i 

CALL  SYMBOL  I W , YHI TE .H 1 . 1 l . 0 1 ) 

I 3N 

0 112 

650 

CONT I NUE 

I SN 

0113 

651 

CONTI NUE 

c 

c 

PLOT  HEADER  INFO 

I SN 

0 1 l 4 

675 

CONTINUE 

69 


1 SN 

Oils 

I F ( 1 EAD < 2 ) . EQ .0  ) GO  TO  725 

I SN 

0117 

XL  -1 . 5 

1 SN 

01  1 8 

V L - 0 . 0 7 

I *^N 

0 M 9 

1 F < I E AD (2 > . EQ .22 1 GO  TO  700 

i SN 

0121 

IF ( I EaD< 2 ) .EQ.25 ) GO  TO  701 

1 SN 

01  23 

I F < 1 £ AD< 2 ) . EG .24  > GO  TO  702 

I SN 

0 125 

IF< IEAPI2 1 .ea.t  I GO  TO  703 

I SN 

012  7 

1 F ( I £AP< 2 ) . Ed .23 > GO  TO  704 

I SN 

0129 

I 8 I 1 E AO < 2 > . E0.2  > GO  TO  70S 

I SN 

01  -'1 

1 F ( 1 E AD( 2 ) .£ Q .4 ) GO  TO  706 

I SN 

0 133 

PRINT  699.IEAD(2) 

I SN 

01  34 

699 

FORMAT ( 1 X STAT ION  1.0.  NO.  IS:  *,151 

I SN 

01  35 

GO  70  725 

1 SN 

01  36 

700 

CALL  SYMBOL <KL. YL.M2 . * ST!  (22)  KIP. *.0..  13) 

I SN 

01  77 

GO  TO  725 

I SN 

01  78 

701 

CALL  SYMBOL  I XL,  YL  .HI,  'ST  I (25)  MA T . • . 0 . , 13) 

l SN 

01  39 

GO  TO  7 25 

I SN 

0140 

7 02 

CALL  SY MROl  < XL . YL .H2 , • St:  (24)  ZLP.'.0..13I 

I SN 

014  1 

GO  TO  725 

I SN 

0142 

703 

CALL  SYMBOl  I XL  , YL  . H2.  • ST  5 (01)  CTA.*.0..13) 

I SN 

014  3 

CO  TO  725 

I SN 

0 144 

704 

CALL  SYMBOL (XL ,YL. H2. *ST:  (23)  ALQ.'.0..13> 

! SN 

0 14  6 

GO  TO  725 

l SN 

01  46 

705 

CALL  SYMBOL ( XL . YL.H2 .’ ST : (02)  CHG«’.0..13) 

I SN 

0147 

GO  TO  725 

I SN 

3t  4 8 

706 

CALL  SYMBOL! XL, YL.H2. *ST:  (04)  TU3.*.0..13) 

I SN 

01  49 

725 

XL-XLtl  4 , *WTH 

I SN 

0160 

CALL  SYMBOL ( XL . YL.H2 . * CH : • .0. .3 > 

I SN 

SI 

XL  = XL  3 3 . « WTH 

I SN 

0 1 62 

CALL  SYMBOL (XL . YL ,H2 .KKL. 0 • .2 ) 

I SN 

H 63 

I F(  IE  ADO)  .EQ.O  ) GO  TO  74  2 

I SN 

0155 

XI  N = l E A 0 ( 3) 

I SN 

0 1 66 

POS=  XL  6 4.  * W TH 

I SN 

01  - 7 

CALL  nuM0ER(POS.YL.H2.XIN,Q.,-1  ) 

I s^ 

">158 

CALL  WHEReiREfX.RETY. RETFAC) 

I 3N 

015  9 

POS-RET X 

1 SN 

0160 

XIN--1£AD<4  > 

l SN 

0161 

CALL  NUMBER! POS .YL . H2 .X IN.O  .. -1  > 

I SN 

01  62 

CALL  WHERE (RCTX  .RET Y. RETFAC ) 

l SN 

0163 

POS  = RET X .2 .*WTH 

I SN 

01  64 

XI  N=I  EAD(  5) 

I SN 

0165 

CALL  NUMBER (POS. YL . H2 .X1N .0 . ,-J ) 

I SN 

0166 

CALL  WHE.PE(R£TX,RETY,  RETFAC) 

1 SN 

01  6 7 

c 

POS-RETx 

I SN 

C 1 6 8 

t F(  1 EAO (6  > . NE .0  ) GO  TO  735 

I SN 

01  70 

CALL  SYMBOL (POS .YL.  H2  . I tHft.O ..4 > 

I SN 

0171 

POS'POS*-  3 . ’ WTH 

r sn 

0172 

GO  TO  738 

I SN 

0173 

V 

73& 

CALL  SYMflOL(POS . YL . M2 .122  ,0  . .-1  ) 

! SN 

0174 

CALL  WUERE(flETX.RETV. RETPAC  ) 

l SN 

Ol  75 

P0S  = fiE  TX 

I SN 

0176 

X 1 N= I FA 0 ( 6 ) 

I SN 

C 1 77 

IF ( X I N.GT .9 • > GO  TO  736 

I SN 

01  79 

CALL  NUMBER  ( POS  .YL  .F<2  . ZER  C .0  .. -1  ) 

I SN 

0180 

CALL  WHERE(RETX.RETY. RETFAC) 

I SN 

01  81 

PO  S=R6  T x 

I SN 

0182 

736 

CALL  NUMBER ( POS . YL . H2 . X I N .0 . . -1  ) 

I SN 

01  8 3 

CALL  WHERE!  RETX.  FfETY  . RETFAC  ) 

I SN 

01  84 

rOS=R£TX 

I SN 

01  85 

£ 

73B 

I P (HEAD ( 7 ) . NE.O  . ) GO  TO  740 

I SN 

01  87 

CALL  S YMBOL< POS . YL . H2 . I t HR.O . .4 ) 

I SN 

0188 

GO  TO  742 

I SN 

01  H9 

C 740 

CALL  SYMB0L( POS  .YL . H2 .1 22  .0  . . -1  1 

I SN 

0150 

CALL  WMER£(R£TX» RETY • RETFAC  ) 

l SN 

01-1 

POS -RETX 

r sn 

01  92 

1 I N-HE AOI 7) 

I SN 

019J 

IF  ( ( IN  . GT  .9  ) GO  TO  741 

l SN 

0195 

call  NUMBER ( POS .YL . H2 . ZERO. 0 .. -1  ) 

I SN 

01  96 

CALL  WUCRE < RC T X.RE Tv. RE TFAC 1 

I SN 

01  97 

pps-RErx 

I SN 

0198 

741 

XIN-'I/N 

ISN 

01  99 

Call  number ( pos .yl .H2 .x in .o -i  ) 

I SN 

0200 

742 

I LAB-LAB. 1 

I SN 

0201 

GO  TOI  760  ,744 . 746 . 744 ) . IL AB 
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ISN 

0202 

C 

C 

c 

744 

LABEL  ROT  AT  1 ON  INFO 
CALL  WHERE(RETX.PeTY.RETFAC) 

I SN 

0203 

POS  -RET x • 2. *WTH 

1 SN 

0204 

CALL  SYMBOL (POS  .YL. H2 .• ANGLE : • .0..6) 

I SN 

0205 

xang-ang 

I SN| 

0206 

pos^  pos  * 6 . * wr  h 

I SN 

0207 

CALL  number.*  POS  . YL  .H2.XANG  .0.  .1  1 

1 SN 

0200 

CALL  WHERE! RETX.RETY.RETFAC) 

1 SN 

02  09 

POS - RE T X*  WT  H 

I SN 

0210 

c 

CALL  SYMBOL! POS. YL.H2.*DeG.*  .0.  .4) 

I SN 

021  1 

V- 

POS  = POS ♦ 5 .•  WTH 

I SN 

0212 

CALL  SYMBOL  (POS  .YL.HZ.  • GA  IN  FACTOP.:'.0. 

I SN 

0213 

POS  = POS  *1 2 . *WT H 

I SN 

02  l * 

XGA 1 N=GA 1 N 

I SN 

02  15 

CALL  NUMBER ( POS  ■ YL  « H2  • X GA  [ N • 0 « • 4 1 

I SN 

021  6 

CALL  WHERE (RETX.RETY.RETFAC) 

I SN 

021  7 

POS=RETX 

I SN 

02  1 a 

CALL  SYMBOLtPOS, YL, H2,  «X  A3’  « 0 • • 4 ) 

! SN 

02  1 9 

c 

1 F ( 1 LAB.E0.2)  GO  TO  750 

I SN 

0221 

V, 

c 

c 

746 

LABEL  FILTER  INFO 
CALL  WH£RE( RETX  .RETY.RETF AC » 

1 SN 

0222 

POS "RET  XT2.TWTH 

I SN 

0223 

CALL  SYMBOL  (POS  .yi-  . H2  , F IL  AB.O  . . 8 ) 

I SN 

0224 

CALL  WHERE ( RE  TX  • RET Y » RE  TF  AC  1 

I SN 

0225 

Y2=RETY 

I SN 

0226 

POS  - RET X 

I SN 

022  7 

tF( SPER.EQ.9999.  ) GO  TO  746 

I SN 

0229 

CALL  NUMBER (POS .Y2. H2 . S PER . 0 . . - 1 1 

I SN 

0230 

CALL  WHCREf retx .rety. retfaci 

ISN 

0231 

POS  RE  TX 

I SN 

0232 

I F ( XLPER. EQ.9999 . 1 GO  TO  747 

I SN 

0234 

746 

xxlper^-xlper 

1 SN 

0235 

IF (SPER.E0.9099 . 1 XXLPE R = - XXLPER 

I SN 

0237 

CALL  NUMBERIPOS • Y2  » H2 .XXL PER. 0 . .-1  > 

1 SN 

02  30 

CALL  WHERE(RETX .RETY.RETFAC7 

I SN 

0239 

POS  -RET  X 

I SN 

0240 

74  7 

c 

CALL  SYMBOL  tPOS .Y2 . H2 . • SEC ' .0 • . 3 1 

I SN 

0241 

V, 

c 

c 

760 

plot  and  label  y-axis 

CONT I NUE 

l SN 

0242 

HYTE=YM IN4YSCAU 

I SN 

0243 

Y l NCR-YMAX/5. 

I SN 

0244 

NUMDEC--1 

I SN 

02  4 5 

I F (y  I NCR.  L.T  .5. 1 NUMOEC  = 2 

I SN 

0247 

DO  000  J=l .6 

ISN 

0248 

XK= J-I 

I SN 

02«S 

Y YY  = X K * Y I NCR*YSCAL  + YOFF 

I SN 

0250 

CALL  PLOT(0.875  .YYY.3) 

I SN 

0251 

CALL  PLOT ( 1 . 12S .YYY. i) 

I SN 

0262 

xypos-yymin*yincr*xk 

I SN 

0253 

CALL  NUMBER (0 .6 .YYY. HI . XYPOS.O. .NUMOECI 

I SN 

0254 

aoo 

CONT 1 NUE 

I SN 

0255 

YYMI  N=YMl  N<-  YOFF 

I SN 

0256 

YHITE=HITETYOFF 

I SN 

0257 

CALL  PLOT  (1  . .YYMIN.3  ) 

I SN 

O2S0 

call  Plot (i . .yhite .2 ) 

I SN 

0259 

CALL  PLOT  (0 . . YM  ITE, -3  1 

I SN 

0260 

Call  plot  (o  . .0 . .5  1 

I SN 

0261 

901 

CONT 1 NUE 

I SN 

0262 

RETURN 

I SN 

0263 

END 

»R> 
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NAME  - - PR  PLT  1 
TYPE--IO 

SOURCE- -A . LAZAREWICZ 


PURPOSE  --  Generates  a plot  of  an  array  on  the  high-speed  line 
printer. 


DESCRIPT1 ON  - -CALL  PRPET1  (X,  LB,  LE , LS) 

X - array  to  be  plotted  (single  precision,  real) 

LB  - first  point  to  be  plotted 
LE  - last  point  to  be  plotted 

LS  - point  increment  (1  means  plot  every  point,  2 means 
plot  every  other  point,  and  so  on) 


I Sn  0 002 


S 06 R OUT  1 NE  PP.PLT  1 ( X , LB.LE.LS  ) 

C FORTRAN  SUBROUTINE  FOR  PLOTTING  AN  ARRAY  X 

C LR  IS  THE  FIRST  POINT  OF  ARRAY  K TO  0E  PLOTTED 

C Lt  I S THE  LAST  POINT  Of  ARRAY  X TO  BE  PLOTTED 

C LS  IS  THE  SKIPPING  FACTOR 

c ARRAY  NMT  CONTAINS  THE  F ORMA  T FOR.  WRITE  STATEMENT  NUMBER  20 

C ROUTINE  BY  MARK  ODEGARD.  UPDATED  ON  GRS DAT  AUGUST  19  73 

C WILL  NOT  PLOT  IF  ABS (M AX . AMPLITUDE)  IS  <=  l.E-60 

C REVISED  BY:  ANDY  LAZAREWICZ.  HAWAII  INSTITUE  OF  GEOPHYSICS 
C LATEST  VERSION:  Oi  APRIL  1976 

C 


1 SN 

0 003 

D | MENS  ION  NMT  ( 9)  . X(  1 ) 

, • .6.  • • • . • | •••.». 000*  . • X,  • • « 

I SN 

0 00  A 

DATA  NMT / M 1 H • . • . 1 5 . • . • 2X . t * • • PE  I 3 • 
• • / , Nk\7/‘  . 000  * / 

1 SN 

0 00  9 

10O  FORM  AT ( • OPO I NT  MAGNITUDE 

2.*  •) 

1 SN 

0 006 

10  1 FORMAT ( • ♦ • • 

2.  ♦ ’ ) 

1 SN 

0 CO  7 

XM AX  =X ( LB ) 

1 SN 

OOCB 

XMl N =X( LB) 

I SN 

0 cos 

DO  10  1 = L0.LE.LS 

1 SN 

0 010 

XMAX  = AMAX1 1 X( 1 ) . XMAX) 

1 5n 

ooii 

10  XMIN  - AM  1 N1  i X ( 1 ) . XM I N ) 

1 SN 

0 012 

XMAX -A0SI  X M A X- XM!  N) 

l.E-60) ) RETURN 

I SN 

1)  ot  3 

IF  ( (XM AX -LE  . ♦ 1 .E-60  1 . AND.  < XMAX -GE 

1 SN 

0 Cl  5 

PRINT  100 

1 SN 

0 016 

DO  20  1=  LB.LE.LS 

I SN 

0 017 

MN  1 .5* (X ( 1 ) -XMl N ) ♦ 100 ./XMAX 

1 SN 

0 018 

M N l = MN  ' 1 0 

1 s N 

0 019 

MM2  = MNl/10 

1 SN 

0 02  0 

NMI  (7)  = NM7  * fcB&36»MN2  + 2.S6  * <A(N  1 - 10  .MN2  ) <(  MN-  10 -MN  I ) 

1 SN 

(10  21 

20  WRI  TE  (6  .NMT)  1 . X ( 1 > 

1 SN 

0022 

PRINT  101 

I SN 

0 02  T 

RF  TURN 

1 SN 

o a?<t 

END 
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NAME  — READ 
TYPE  — 10 

S0URCE--A.  LAZAREWICZ 

PURPOSE- -Reads  and  interprets  one  record  from  7 -TRK  data  tape. 

Fills  six  arrays  with  data  and  supplies  header  information. 
Interprets  error  codes  from  KREAD . 

DESCRIPT  I ON  — CALL  READ  (NREC , 1PRT) 

NREC  - the  number  of  the  record  to  be  read 
1PRT  - print  code 

0 - print  nothing  (except  errors),  fill  arrays 

1 - print  one-line  header,  fill  arrays 

2 - print  long  header,  fill  arrays,  print  arrays 

3 - print  one-line  header,  do  not  fill  arrays 

A - print  nothing  (except  errors),  do  not  fill  arrays 

COMMON / SMACK/  contains  data  from  tape: 

A1  - vertical  velocity  channel 
A2  - NS  vel.  channel 
A3  - EW  vel.  channel 

Bl  - vertical  displacement  channel 
B2  - NS  disp.  channel 
B3  - EW  disp.  channel 

HEAD(IO)  - header  information  (see  listing) 

IREC  - number  of  the  last  record  that  was  read 


rTi.iCc.DINj  BA3S  BLANK-,. OT  ? TU'l^U*  " 


74 


NOTES  - - In  general,  tbe  only  time  a 
directly  is  to  skip  part  of  a 
a Ions  (several  days)  section 
consider  a tape  that  contains 
in  one  file: 


main  program  calls  READ 
data  tape  where  there  is 
of  flats  missing.  For  example, 
the  following  sets  of  data 


1975-323-00:00:00  to  1975-326-15:00:00  and 
1975-340-12:00:00  to  1975-350-03:00:00 

A call  to  FIND  with  ISTART  as  a time  in  the  second  set  of 


data  may  result  in  an  error.  FIND  reads  the  first  record 
and  uses  that  start  time  to  calculate  the  record  number 
that  corresponds  to  ISTART.  Because  of  the  gap,  the  calcu- 
lated record  number  could  be  larger  than  the  number  of 
records  in  the  file  and  an  error  may  result.  The  solution 
is  to  CALL  READ  (NREC,  4)  , where  NREC  is  a record  number 
in  the  second  stretch  of  data  but  before  the  start  of  the 


data  to  be  read  from  the  tape.  This  merely  advances  the 


tape  past  the  gap.  A subsequent  CALL  FIND  will  work 


I SN  0002 

C 

c 

c 

c 

c 

c 

c 

c 


T SN 

0003 

I SN 

0004 

r sn 

0005 

! SN 

0006 

! SN 

000/ 

1 

I SN 

OOCB 

7 

I SN 

0009 

3 

f SN 

00  1 0 

4 

T SN 

00  l 1 

5 

r sn 

001  2 

6 

T SN 

00  11 

7 

properly. 


SUBROUTINE  RE  AO < NREC • IPRT  > 

THIS  IS  A I APE  READING  PROGRAM  FOR  THE  RAYLEIGH  WAVES  PROJECT. 
SUMMARY  OF  TAPE:  / TifACK,  6006  6-BIT  BYTES.  ONE  FILE  P FR  TAPE. 

PLEASE  SEE  DOCUMENTATION  ON  USE  OF  THE  PROGRAM,  AS  SPECIFIC 
INTERACTION  WITH  THE  CALLING  PROGRAM  IS  REQUIRED.  LATEST 
VERSION'.  16  MAY  1974. 

WRITTEN  BY  ANDY  LA/  ARE  W I C 2 • HIG-215  X-3143. 

I NTE  GE  R* 2 CH.IMI  3 50  0)  .INI  1 1 1 I .ICNVI6)  , IPARi  I 990 I.LAPI2)  .ERR (25) 
Dimension  ieaoiio). ibofi  1998). iai (55  5) , IA2<  555) .ia3«  555) • 

. TBl  ( 1 1 I ) . 1021  ] I I ) . IB3I  111) 

COMMON /SMACK/ a I ( 555 ) . A2( 555 ) . A3 ( 555)  . B 1 ( 1 1 1 > . B2<  1 1 » > . B 3 ( I I I ) . 

• HE  AD ( l 0 ) . I REC 

E QU I VALENCE! HE ADfl  ).  IEAO! I ) ) . (KAP.LAP!  1 ) >.  fAl!  I ).  I A 1 ( 1 ) ). 
.(A2(I).IA2(I)».!A3!I),IA3(1>).  (B)(1).  I B 1 ( l ) I . ( R2(  I > . I B2  < l > ) . 

. ( S3!  1 > . I 63 ( 1 ) ) . ( IM(  1 ) ,ERR< I > ) 

FORMAT(I5(200A2) .3A2) 

FORMAT!*  ***  DATA  PARITY  ERROR  AT  *.Z2.'  - *.I3.*  »»«•) 

f ORM  AT  f * NORMALIZED  LISTING  IN  VOLTS  FOR  RECORD  *.IA./.*  9TATION  • 
..12.’.  DATE:  * . 14 .* -• . I 3. * . time:  • , 12. • : • . 1 2. • : • .F4. 1 ./.  • 

.A  CHANNELS.  *.I1.*  B CHANNELS.  SAMPLE  RATE  = *.f3.l.//) 

FORMAT (!4. IX, I5I2X, 16)) 

rOftMAT!*  RECORD  *.I4.*  HAS  *.I4,*  BYTES.  SHOULD  BE  600b.  DATA  SKIP 

• PEO.  * ) 

FORMAT ( I4.1X.3I2X.I6)  ) 

FORMAT! • SEC ,.2X.5(4X.’A1*.6X,*A2'.6X.*A 3 • . 2* ) > 
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I SN 

0^  1 4 

f (1RM  A T ( 

SEC*  ,?K,S<4X.«HI*,ftX,*H2*,ftX, 

I SN 

00  1 s 

9 

f-ni4MA  f ( 

RE C nun  •.I4.*.  STATION  • • ! 2 

. • 

• •-  • . ! 2 . • 

’ . I 2 . • : • .F  A . 1 . • . < • . t 1 . • . • . 1 

1 , 

• A T F : • , 

K 

3.  1 ) 

I SN 

00  1 b 

1 0 

F ORMA  T ( 

END  OF  FIIF.  >.IA,'  PF  COR  OS 

• 

I SN 

Oft  I 7 

1 2 

F OPM  A T ( 

♦ READ  FRW|)R  IN  RECORD 

• . 

• to  • ♦ • * 

* 

• ) 

C 

C 

c moose 

and  RF  AO  OFSIPEO  RECORD 

*H3*  . 2X1  ) 

, oat f e time:  • . i a* • - • , i j.  • 
•I*  <a,w>  Channels,  smaplf  p 

OFSIPED  PFCOPO  HAS  M4) 

••?*>  A?.«,  PFCJJPD  S*IPP 


I SN 

CO  I 8 

1 04 

1 RE  C NRE  C - f REF 

I SN 

00  1 9 

IF  (I  REF.GT.O)  GO  TO  103 

I SN 

002  1 

CALL  KPDDK ( I M ( 3500  ) • I BYTE  ) 

T SN 

0022 

T PEC  =t  REC- 1 

I SN 

002  3 

GO  TO  104 

I SN 

0 02  4 

1 0 3 

DO  1 1 J“1  ,1  REC 

l SN 

OC  25 

I PEC  = I REC ♦ 1 

I SN 

0 02  6 

CAl  L KPE  AD<  I M,  1 BYTE  ) 

r sn 

002  7 

I r ( I BYTE. NF . -40000 ) GO  TO 

I SN 

0 029 

MPEC = I PEC-  l 

[ SN 

0 0 30 

W9!TF(,»t10>  MPEC,NPEC 

T SN 

00  3 1 

f E ADC  l ) =-  1 0 

1 5 N 

0032 

GO  TO  200 

I Sn 

0 0 33 

1 01 

IF  ( I BY  re. NE. -50000  ) GO  TO 

I SN 

00  35 

wP ! T E ( 6 • 1 2 ) I REC ,ERP 

I SN 

OC  36 

I F ( I «EC • EO . NREC  ) GO  TO  200 

I SN 

0 0 3 0 

GO  i o l 1 

I SN 

C 0 3 9 

l 02 

IF  < I BYTE. E0.6006 > GO  TO  l 

I SN 

00  4 1 

WRITE  (6.5)'  IREC,  (BYTE 

I SN 

00  4? 

IF  Cl PRT  .EO. 2 » IPRT  = 1 

I SN 

0 04  4 

1 1 

CONTI NUF 

I SN 

00  45 

DO  15  J - l ,6 

I SN 

0 0 4 f> 

K 1 = ! M<  J ) / ? 56 

I SN 

0C4  7 

K 2 “ I MC  J)  -K 1 *256 

I SN 

00  4 8 

PO  16  J 1 » 1 . 6 

I SN 

0 04  9 

LI =K2/2 

I SN 

0050 

L 2-L  1 *2 

I SN 

005  1 

J?s(  J*  1 ) * 1 24  1 3-J  1 

T SN 

0 0 62 

I N( J2) =K2-L2 

I SN 

00  5 3 

1 6 

K 2=L  1 

( SN 

3 0 54 

On  17  j i ~ l .6 

I SN 

0 0 55 

1 l-Kl/2 

I SN 

0 0 56 

L 2 “L  l * 2 

I SN 

00  57 

J2-CJ-1  ) * 1 2 4 7 - J 1 

T SN 

0 068 

INC  .12  ) -K  1 -1  2 

I SN 

r 0 6 O 

1 7 

K1=U 

I SN 

0^60 

l 5 

FONT T NOE 

1 0 1 


I 0? 


c 

c interpret  header  and  form  f i xed/float  head  array 

c l .'RELATIVE  RFCn»r>.  2:station  10,  1IYEAP.  AIJULIAN  day,  5:  HOOP* 

r r. : *•!  note  S • 7 : secono  s • 8:nomrfp  of  a channels,  9:nijmbfp  of  b 

c channels,  io:samplf  patf. 


c 


I SN  0 0ft  l 
ION  00  ft  2 


f SN  00ft 3 

f s N 0 0 6 4 

TON  0 
I SM  ^ ft  ft  ft 

r sn  ooft  7 

T SN  O* ft q 

f SN  0069 

f SN  00  70 


I c AO ( 1 ) -I  PEC 

jrAr>(?)-lO*<rt*lN<3M4MN<4)*2*lN<b)*lN<6>)*8*IN<9)*4*lN<IO)* 

• 2*  T N<  1 t ) f IN(  12) 

I F AO  ( 1)  tlO70,ffl*!N(  !5)MMN(  1M42*IN(  17)MN(  1«) 

r E AO(  4 1 = I 09  * ( 2 * I N ( IP)  4 IN(  20  > )A10A(6*IN(21  > ♦ 4*  I N<  ??  I ♦ I N(  ? 1 ) ♦ 
•IN(?4))*H*lN(25)A4AIN(26>ft?*IN<27)ft|Nf2fll 
I F M)(  5)“10M?*IN(  31  )♦  IN(  32)  ) F «♦  I N ( 3 3 ) ^4*  ! N(  34  I 4-2*  I N ( 35 ) 4 1 N(  3ft) 

IF  AD  ( 6 ) - 1 0 * < 4 A I N{  37  U?*1N(  3B)4IN(  39)  )fH*lN(  40  ) 44  ♦ I N<  4 I ) 4 2*  I N(  4 2)  4 

• I N ( 4 3 ) 

MF  AO(  7)  = !0*C4*IMC44)4^*INC  A5)MN(46)  ) * I N(  4 7)  ♦ 4*  I ^ ( 48  ) ♦ 2*  I N(  49  ) ♦ 
« I N ( 50  ) ♦ 0 • I * C R * I N ( 5 1 ) f4  * I N ( 5?  ) 42  * I N(  5 3 ) ♦ l N ( *34)  ) 
j(  Af)(  fl)  =R*  1 N(  57)  ♦A*  IN(5R)4?*1N(59)MN(60) 

TEA  0(0)  - 4*  INC  04  | 42*  f N ( 6 *3  ) 4 f N ( 6ft  I 

HC  AO  ( 10)  -rQ  # 5 ♦ 1 N ( 6 7 ) 4 I N ( 6 B )4?*TN(ft9)  44  * I N ( 70  ) 


I SN  00  7 1 
I S N 0 0 7 1 

T SN  00  7'. 
I S N 0 0 7 7 
i S N 0 o 7 
r SN  00  «9 
I sn  0 0 n l 


print  header 

IF 

| PR  T - 1 ,2  In  approppi atf  format 

IF 

( IPwr.tQ.ft) 

GO 

TO 

pn 

I F 

( 1 POT  . E 0 . 2 ) 

GO 

TO 

65 

IF 

< IPPT.F0.4) 

GO 

T o 

200 

«»HE(  r><9)  ! IE»I'(  J|  , J-l.M  .HF  »D(7I  .(  tF«0(  Jl  10) 

ir  (IPRT.EO.3)  GO  TO  POO 
GO  TO  PS 

GG  WU [ TF ( b . 3 ) <IEAr><JT.J  = t.6)»HFAO(7).<lEAT>(JI.J  = 8.,J>.HFAr>(10t 


7b 


I 


! SN  0 0 6 2 

i sn  ooe<* 

I SN  COflS 
I SN  0086 
I SN  0087 
I S N 000* 
ISN  0089 
l SN  00Q9 
ISN  0 o O i 
ISN  '>*0? 
ISN  00O1 
I SN  0004 
I SN  O0OS 
I SN  0096 
ISN  C^O  7 
ISN  O09H 
ISN  00  09 
ISN  O 1 00 
I SN  0 1 O 1 
ISN  0102 
ISN  0 1 0 J 
ISN  0104 
ISN  OIOS 
ISN  "l  06 
ISN  0 1 O 7 


ISN  0106 
ISN  0109 
ISN  0111 
ISN  0112 
ISN  0M3 
ISN  0114 
ISN  0115 
ISN  0117 
ISN  0119 
ISN  0121 
ISN  0123 
ISN  0124 
ISN  " i 2S 
ISN  0127 
ISN  0129 
ISN  0131 
ISN  01^2 
ISN  0131 
ISN  0114 
ISN  ni  IS 
I SN  0 I 3 7 
ISN  0119 
T SN  0 14  1 
ISN  0143 
ISN  0144 
T SN  0 1 4 S 
ISN  TM7 
T SN  0 149 
I SN  0 1 SO 
ISN  01*1 


ISN  01S2 
f 0101 
ISN  9154 
ISN  9 1 55 
ISN  9 1 06 
ISN  0 I S 7 
ISN  9 1 S 0 
ISN  0159 
ISN  0160 
ISN  9161 
ISN  0162 


C 

C NOW  WFAD  data:  C ONVFWT<  1 1 1 ( 5<  A1  . A2  • A3  ) • I ( 81  • 02,03  > >>  TO 

C 555 A 1 .555 A 2. 555 A 1 • 1 1 1 fl 1 . 1 1 1 02 . 1 1 1 B 3 . 

C MAX.  FIInAPY  COUNTS  IN  ANY  CHANNEL  IS  36767. 

C sru~'  sequential  digital  data  to  ibuf.  search  for  parity  BIT  AMO 

C LOAD  INTO  ARRAY  IPAR. 

c 

20  IF  ( I BYTE. EQ. 6006)  GO  TO  31 
DO  32  J~ 1 . 1 990 

32  I RUF ( J) =40000 
GO  TO  33 

31  JC  NT  =1 

DO  26  J=6.  5000.3 

DO  2 ? J 1 ■=  1 , 3 

ICNVt  J 1 *2-1  ) = IM(  JfJl  )/256 
I ARC  - I M<  J ♦ J 1 ) 

2 2 1 CNV  ( J I *2  > =MOO<  I arc;.  2 56  > 

DO  24  jl =1 ,4,3 

I ADij:  I CNV<  J 1 ) 

l L -MQO(  C APS, 256 1 

l R- I CNV ( Jl f 2 ) /2 

K AP=H  *2O40MCNV<Jl*l)*3?7|R 

I PUF ( JC  N T ) =LAP<  2 ) 

I CMK  =0 

DO  23  J 2 = 1 . 16 
ICHKsI CMK+MOOC KAP.2) 

2 3 kap=kap/2 

I ARG= I CNV ( J 1 ♦? ) 
i chk =i CHKtMoni iarg.2) 

I OAP( JCNT ) =MO0( ICHK.2) 

24  JCNT=JCNT+1 
26  CONTINUE 

c 

C CORRECT  AND  LIST  DATA  PARITY  EPPORS 

C 

DO  29  J - 1 . 1 998 

IF  ( I PARI J)  .EO.I  ) GO  TO  29 

J2  = < J- I )/18fl 

J 3 = J- C J 2- l > ♦ l 8 

J4-( J3-1 >/3f  1 

J 5 = J 3 - 1 J 4 — l ) * 3 

Ip  ( J3.GT. 1 5)  GO  TO  13 

IF  ( J5. EQ. I ) CH= 161 

IF ( J5. EQ. 2 ) CH= 1 62 

IF  (J5.EQ.3)  C H = 1 6 3 

J7  = ( J2-1  ) *54- J4 

GO  TO  14 

13  IF  U1.HO.1fi)  CH-177 
I F ( J3. FQ. 1 7 ) CH-1 78 
1 F ( J 3 • E Q • 1 0)  CH  = 1 79 
J7  = J?*S 

14  WR  I TE  ( 6 . 2 > CM,  J 7 

T m9  = 3 

I 0 4 K = 3 

( J4.HO.fi)  1 FOR =6 
1 F (J4.E0.fi)  IFOR- 1 3 
IF  ( J4 . FQ. 1 ) I 0AKrfi 

I F ( J4.EQ.6)  I BAK  - 1 0 
JL- J - T OAK 

jHrr  J*  l F OP 

IF  ( Jl  . l T.  1)  JL  “ JH 
IF  (JH.GT.1998)  J H — J L 
I RUF  ( J ) -(  I RUF  ( JL  I A I RUF  ( JH  ) )/2 
29  CONTINUE 

33  CONTINUE 
C 

C REASSIGN  l 0UF  TO  CHANNELS  A £ R 

C 

J A “ 0 
JO-0 
Jl  = 1 

DO  39  J=  1 . 1 1 1 
DO  14  Jl =1 ,5 

J A ^ j A ♦ l 

A ] ( j A ) - I PUF ( J I ) 

A2I  ) A ) - T RUF ( Jl  »1  ) 

A3(  JA)=I RUF ( Jl *2  ) 

34  JT  = J I ♦ J 
JB-JBf 1 


I SN 

0163 

0!  ( JB)  =1 BUF ( J II 

I SN 

0 1 64 

B2  < JB I = I BUF ( J I ♦ 1 ) 

! SN 

0 165 

B3<  JB)  =I6UF ( Jl *z ) 

I SN 

0 1 66 

39 

c 

J I = J 1 * 3 

V. 

c 

/• 

NOW  PRIN1  4RRAY  IF  !PRT=2 

I SN 

0 167 

V. 

IF  ( I PR  I. ME. 2 I GO  TO  200 

I SN 

0 1 69 

00  69  J = 1 . 555 

I SN 

0 1 70 

I A 1 ( J I =4 1 ( J I 

t SN 

01  71 

1 A2 ( J) -A2 ( J) 

T SN 

0 1 72 

IA3(J)=A3(J) 

I SN 

0 1 7 3 

IF  (J.CT.1UI  GO  TO  69 

I SN 

01  75 

I B!  ( J)  =81  ( J I 

I SN 

0 1 76 

I B2 ( J I -82 ( J 1 

I SN 

0 177 

t B3(  J I = B3(  J I 

t SN 

0 1 78 

69 

CONTI NUE 

I SN 

01  79 

WR  I T E ( 6 • 7) 

I SN 

0 1 80 

00  60  1=1,111 

T SN 

0181 

IN(L)=(L-1 1*5 

I SN 

01  82 

UU=(L-1 I *5+ 1 

I SN 

01  83 

LM  = L.LF4 

l SN 

01  84 

60 

WRITg  (6.4)  (lN(t_).((tAl(IC),IA2<K>.IA3<K)> 

. K =L  L »l  H M 

I SN 

0 1 85 

WMI TE( 6.8) 

I SN 

01  86 

Oil  6 1 L =1  .2  1 

t SN 

01  87 

INILI-IL-1 )«25 

ISN 

0 1 88 

LL= (L- 1 ) *5* 1 

I SN 

01  89 

LH  =LL»4 

I SN 

0 1 00 

6 1 

WR[TE(6.4)  < IN(1_).((IBI(«C).1B2(K)  .IB1IKII 

,K  = LL .LH)  ) 

T SN 

0101 

1 N ( 22 ) =525 

T SN 

0 1 92 

WR 1 TE  ( 6 . 6 1 !N(22),(I61(lll).l B2  ( 1 1 1 ) • I B3 i 

III)) 

I SN 

0 1 93 

DO  75  J = 1 . 555 

T SN 

01  9^ 

A 1 ( J ) = 1 A 1 I Jl 

I $N 

01  95 

A2(  J)  =1  A2(  J) 

! SN 

0 1 96 

A3( J)-|*3!J) 

! SN 

01  97 

1 r < J. GT  . 1 1 1 1 GO  TO  75 

T SN 

01  99 

01  < J) =! B1  < J) 

I SN 

0 200 

02 ( J ) = 1 B2 ( J ) 

T SN 

2 0 1 

83  < J)  =I03( J) 

1 SN 

0202 

7 S 

CONT 1 NOE 

I SN 

0203 

200 

RE  TORN 

I SN 

0204 

F NO 

NAME- -ROTATE 


TYPE  - -DATA 
SOURCE  - -D . CHESLEY 

PURPOSE--Converts  NS  and  EW  data  to  radial  and  transverse  data. 

R is  positive  toward  epicenter,  T is  positive  to  the 
left  when  viewing  from  station  toward  the  epicenter. 

DE SCRIPT I ON  - - CALL  ROTATE  (PHI,  G,  NUM) 

PHI  - angle  of  rotation  (N  through  E)  in  degrees 
G - gain  of  channel  A3  relative  to  A2 
NUM  - = 0 rotates  data  returned  from  FIND 
=■  1 rotates  data  returned  from  READ. 

COMMON --/SEARCH/  contains  data  from  FIND  to  be  rotated  if  NUM  « 0. 

/SMACK/  contains  data  from  READ  to  be  rotated  If  NUM  « 1 
/TURN/  contains  rotated  data.  CHR  is  radial;  CHT  is 
transverse 

/ANGLE/  contains  label  information  for  PLT1 
/X/  contains  length  of  array  to  be  rotated 
ROTATE  does  not  change  any  values  In  /SEARCH/,  /SMACK/,  or  /X/. 


r'K.SCc.DI  M3 


?A0S  BLANK-.  iOT  FlfiS 


80 


I SN 

0002 

r 

SUBROUT  1 Nfc  RUTATEtRMl.&.NUMl 

c 

ROTATE  IS  DESIGNED  TO  ROTATE  SEISMOGRAMS  IN  ORDER 

c 

TO  CONVERT  FROM  N-S  ANO  E-W  TRACES  Til  RADIAL  AND  TRANS 

c 

TRACES.  PHI  IS  THE  ANGLE  OF  ROTATION  IN  DEGREES 

c 

ANO  G IS  THE  GAIN  OF  THE  A2  CHANNEL  RELATIVE  TO  THE  A3 

c 

CHANNEL.  NUM  = 0 ROTATES  THE  CH  ARRAYS  AS  RETURNED  FROM 

c 

•FIND*  AND  NOM=l  ROTATES  Tot  A CHANNEL  S RETURNED 

c 

FROM  ■READ' 

c 

WRITTEN  by  OONCAN  CHESLEY  HI  G- 320  X-  70  70 

c 

£ 

LATEST  VERSION:  7 SEPT  1974 

I SK 

000  3 

COMMON/SEARCH/ CHI (5550>,CH2<5b50).CH3<SS50> 

I SN 

0004 

COMMON/ SMACK/ A1  < 55  5 ) . A2 ( 5 3 5 ) . A3 ( 6S5  > . B 1 < 1 1 1 » , B2 ( 1 I 1 > . 
• 03 ( 111)  . HE  A 0 ( 10  ) , IREC 

I SN 

000b 

CUMMON/TURN/CHRI 5bS0 ) . CHT  < 5550  ) 

l SN 

0006 

COMMON/  ANGLE  /ANG.I.AIN 

I SN 

ooc  y 

COMMON/*/ I XM AX 

I SN 

0 C 0 8 

PHI1 =PHI • 2.  » 3. 14159265/360. 

I SN 

OOC  9 

ANG  =PH I 

I SN 

CO  1 0 

GA I N=G 

I SN 

OC  1 1 

SI  NE  = SI  N(  PH  I 1 ) 

I SN 

OC  1 2 

COS  I N£  = COS( PH  I 1 ) 

I SN 

00  13 

I I XMA  X= I XMAX 

1 SN 

00  1 9 

IF  (NUM.EO.l)  IIXMAX=85b 

I SN 

00  I 0 

DO  100  J = 1 . I IXMAX 

I SN 

00  17 

IF  ( NUM.EO. 1 ) GU  TO  90 

I SN 

0019 

C HR  ( JI=G*C.H3(J)*SINE*CH2(JI  *CO  SINE 

I SN 

0020 

CHT  ( J) =-G*CH3 ( J ) *COS INE  AC H2  < J ) *S INE 

I SN 

002  1 

GO  TO  100 

I SN 

0022 

90 

CHR<  J ) =G*  A3  < J ) *S  INE  >A  21  J ) *C.OS  INE 

I SN 

0023 

CHT  < J) =-G*A3 ( J ) *COS INE*  A2  < J ) *S INE 

I SN 

0024 

100 

CONTINUE 

I SN 

0025 

RETURN 

I SN 

0026 

END 

If 


‘ 


81 


NAME - - SEC  2HD 
TYPE--UT1LITY 
SOURCE--D.  CHESLEi 

PURPOSE--  converts  seconds  since  1968  (IGNORING  LEAP  YEARS  and 
1-sec  adjustments  of  VJWV(H))  to  an  array  of  year,  day, 
hour,  minute,  second. 

DESCRIPTION--CALL  SEC2HD  (IB,  1A) 

IB  - integer  number  of  seconds  since  1/1/68 
IA  - dimension  = 5,  integer  array  to  contain  year,  day, 
hour,  minute.  Second. 

NOTES -- SEC 2HD  performs  inverse  process  of  HD2SEC. 


1 SN 

0002 

SUBROUTINE  SEC2HOt 10. IA » 

I SN 

0003 

D 1 ME  NS  ION  1 A( 5) 

1 SN 

000* 

NUMSEC =365*24 *3600 

I SN 

0005 

I A< 1 ) =1 0/NUMSECt 1 960 

I SN 

0 0 05 

IC=IB-(IA< 11-1968) * NUMSEC 

I SN 

0007 

NUMSEC=24*36O0 

I SN 

0000 

1 A(2) = 1 C /NUMSEC 

1 SN 

0009 

I C- t C- I A<  2 » *NUMSFC 

I SN 

00  10 

I A ( J ) = I C/3600 

1 SN 

001  1 

I C = IC- I At  3) *3600 

1 SN 

00  1 2 

I At  4 ) =1  C/60 

l SN 

00  1 3 

l AtS  > =1  C- 1 A(4  > *60 

I SN 

0014 

PETU«N 

T SN 

0015 

END 

83 


NAME- -SETCC , SETNP  , SETXYN 

TYPE--UTILITY 

SOURCE  - - D . CHESLEY 


PURPOSE -- Ini t la  1 iz es  various  parameters  necessary  for  correct 
operation  of  entire  system  of  subroutines.  SETNP  Is  used 
except  In  programs  that  generate  a XYNETICS  plot  or  a 
CALCOMP  plot.  Those  programs  use  SETXYN  and  SETCC,  respectively. 

DESCRIPTION --CALL  SETCC,  CALL  SETNP,  CALL  SETXYN 

SETCC,  SETNP  or  SETXYN  must  be  called  once  at  the  beginning 
of  each  main  program 

COMMON/SMACK/  contains  IREC,  which  must  be  set  to  zero  before 
any  tape  reading. 

IREC  counts  records  on  the  data  tape  /SMACK/  also  contains 
the  header  array  (HEAD ( 10) ) , which  Is  initialized  to 
zero 

/FILT/  contains  label  information  for  PLT1 
/PLTPAR/  contains  variables  used  by  PLT1 

XOFF  = x-dlstance  in  inches  from  Initial  pen  position 
to  origin  of  plot  (lower  end  of  Y-axis) 

YOFF  = Y-distance  in  inches  from  initial  pen  position 


to  or 

igin  of  plot 

HI  = height 

i n 

inches 

o f 

small 

letters 

in 

plot 

H2  = height 

i n 

inches 

o f 

large 

letters 

in 

plot 

r'RiCt.DIND  PAGE 

■"‘m •• 


BLANK-. ,0T  nuisfi 
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NOTES--The  statement  CALL  SETCC  must  be  used  if  the  plot  is  to 
be  made  on  a CALCOMP  plotter.  Care  must  then  be  taken 
that  the  total  height  of  the  plot  to  be  generated  (Including 
YOFF)  does  not  exceed  11  inches,  but  no  other  programming 
change  need  be  made.  The  labels  for  the  etart  time,  station, 
and  channel  name  might  not  be  properly  spaced  in  the  CALCOMP 
plot  . 


ISN 

0002 

SUBROUTINE  SETCC 

1 SN 

0003 

COMMON/SMACK/  A1  (5S5  1 . A2  < 5 S 5 ) . A3  < 555  ) , Bl(  llll.BZdll  » 
. B3<  1 1 l > • ME AD < 1 0 ) , I REC 

I SN 

0004 

C OMMON/Fl LT /F 1L  AB<  2 ) , SPER . XLPEP 

! SN 

0005 

COMMON/ PL  TPAR/X0FF . VOFF ,H1  , H2 

1 SN 

0006 

DIMENSION  IEADU0I  .BUFFERI10O01 

I SN 

0007 

tout  VALFNCEC  HE  AO  <1  ) . I EA0< 1 ) ) 

1 SN 

0008 

SPER=»9Q9. 

I SN 

0009 

XLPtR  - 9999. 

! SN 

0010 

I REC -0 

I SN 

0011 

MI -Z . /25. 4 

1 SN 

0012 

H2  - 0 . 1 5 

I SN 

001  3 

X OF  F - 1 . 

I SN 

001  4 

TOFF  -0.25 

I SN 

0015 

NBUF'4000 

! SN 

001  6 

call  pi. ots<  suffer. nbuf  > 

I SN 

001  7 

00  2S  J- I .1  0 

t SN 

001  8 

IF ( ( J.EC. 7) .OR. ( J.EQ.10 » * GO  TO  2A 

I SN 

0020 

I E AO  ( J)  =0 

I SN 

0021 

GO  TO  25 

I SN 

0022 

24  MEAD! J ) -0. 

I SN 

00  23 

25  CONTINUE 

1 SN 

00  2 4 

RETURN 

l SN 

0026 

END 

I SN 

0 00  2 

SUBROUTINE  SETNP 

I SN 

0 00  3 

CO  MM  ON/ S MACK /A  l (555) . A2( 555)  . A3 (555  > .Bl(  111  ) .B 2(  1 1 1 1 , 

.83(111)  .HE  AD( 1 0 ) . IREC 

1 SN 

0 00«* 

D I MENS  ION  I E AD<  1 0 > 

I SN 

0 005 

EQUIVALENCE  (HEADU  ).  IEADC1  ) ) 

I SN 

0 006 

IREC  =0 

I SN 

0 00  7 

DO  2 5 J-  J • 1 0 

I SN 

0 000 

1 F < < J. EQ . 7 > • OR . ( J .EQ. lO ) ) GO  Tq  24 

I SN 

0 01  0 

I E AD  C J)  *0 

1 SN 

001  1 

GO  TO  25 

I SN 

001  2 

2 4 

HE  AD  ( J)  sO  . 

1 SN 

0013 

25 

CONI  1NUE 

ISN 

0 014 

RE  TURN 

I SN 

0 015 

END 

I 
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I SN  0002  SUBROUTINE  SfcTxVN 

I SN  0 00  3 CO  mm  ON/ SMACK/  A I (5  5S  ) . A2<  55  5)  . A3<  55S) . SI  ( 11  l I .B2<  I 1 1 I ,B3(  1 1 I » . 

.HEAD ( 10 ) . IREC 

I SN  0 004  COMMON/F  IL1/FIlAB(2J,SPER.  XLPER 

I SN  0005  COMMON/PLTPAR/XOFF.YOFF,  HI  .M2 

I SN  O 00  6 D I ME  NS  I ON  I E AD  ( 10  > 

I SN  0 007  EQUIVALENCE  ( HE AD ( 1 ) . I C ADI  1 ) ) 

1 SN  0 008  SPER-99U9. 

I SN  0 00  9 X L PE  R - 99  99  • 

I SN  0 01  0 I RE  C =0 

I SN  001  1 HI  ^2.225.  4 

ISN  0 012  H2-0  .15 

1 SN  0 013  XOFF  =1  . 

ISN  0 014  YOFF  =0.  2 5 

I SN  0 01 5 I U N 1 T = 1 

I SN  0016  CALL  PLOTS  < ND  . NE  . ZUNIT  1 

I SN  0 01  7 DO  25  J--1.10 

ISN  0010  IF  ( C J.EQ  . 7)  . OR  .(  J .EQ.  10)  ) SO  TO  24 

I SN  0 02  0 I E AD  ( J)  =0 

1 SN  0 02  1 GO  TO  25 

ISN  0 022  24  HE  AO  < J I =0  . 

ISN  0 02  3 2 5 CONTINUE 

ISN  0 02  4 RETURN 

I SN  0 02  5 END 
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NAME - -SHRINK 
TYPE--  UTILITY 
SOURCE--D.  CHESLEY 


PURPOSE--makes  data  returned  from  FIND  correspond  exactly  to 
desired  start  and  stop  times. 

DESCRIPTION- - CALL  SHRINK  (IBEG  , IEND) 

IBEG  - (dimension  * 5,  integer)  contains  year,  day,  hour, 
minute,  and  second  of  desired  first  data  point 
IEND  - (dimension  - 5,  integer)  contains  time  of  last  data 
point 


COMMON - - /X / - IXMAX  is  the  length  of  the  data  in  CHI,  CH  2 , and 
CH 3 . IXMAX  is  decreased  by  SHRINK. 

/SEARCH/  - contains  the  data 

/SMACK/  - contains  HEAD ( 10) , which  gives  the  start  time  of 


the  data 

HEADilO)  is  changed  by  SHRINK 

N0TES--READ  is  capable  of  reading  and  interpreting  entire  records 
(555  sec).  SHRINK  takes  the  data  in  CHI,  2,  and  3,  which 
must  be  a multiple  of  the  record  length,  and  deletes  data 
from  beginning  and  end  so  that  only  the  desired  data  are 
in  CH  1 , CH 2 and  3.  SHRINK  operates  on  all  three  channels 
simultaneously  and  is  called  at  the  end  of  FIND. 


PHSClDING  PA3S  BLANK-., 0T  PI 


8 b 


1 bN 

0002 

subroutine  shr ink i ieeg, ienoi 

l SN 

0003 

COMNON/X/l KMA) 

ISN 

0004 

COMMON/SEARCh/CMI  C5S50  ).CH2(5SS0)  ,CH3(5SbO) 

1 SN 

ones 

c Omwun/Smac  K/  4 1 (5  5S  ) . A2( $55  ).A3<S5S>.8l(»)l 
• BJ<  11  l ) , l<E  ALM  10).  1 R EC 

1 >N 

0 0 06 

INTFl.ER  QL  L . END.  S IARI  . ST  OP 

1 '.N 

000? 

U 1 Mt  NS  1 ON  It.  fiO  ( 1 0 ) . I HE  AD  <5  ),N  S I 7 < S ) . lt)C  G( 

1 >N 

0008 

c 

F GUI  V Al.fcNCE  < HE  AO  ( 1 ) . 1 F flO(  1 ) ) 

1 SN 

OOOR 

V. 

CALI  H0  2St<  < IfcfeG.EEO) 

I SN 

00  10 

CAli  M02  b £ < < I6NC.EN0) 

1 SN 

00  1 l 

CALI  HOCONV  ( KST  AM  . 1 ) 

1 

00  1 2 

CA1  l HD2 SEC (KS I AP T . ST  ART ) 

1 SN 

00  13 

Slul’-SIAHTt  I aHAX-  1 

1 SN 

00  14 

KXNA*  =ENO  - BE<o+  1 

I SN 

00  1 5 

00  20  J- 1 .KXMAX 

1 SN 

00  l 6 

J 1 - Rfc  0 - S I A R 1 * J 

I SN 

00  1 7 

chkji  =chi  < ji  ) 

ISN 

00  1 8 

CH2IJI =CH2<  J 1 ) 

I SN 

00  1 <7 

CHi( J )=CH3( J 1 ) 

I SN 

0020 

20 

CONTI NuE 

I SN 

0021 

C 

call  HOCONV < 1 EEG.  - 1 1 

I SN 

0022 

i xmaX  = k**ax 

ISN 

0023 

RE  TURN 

I SN 

0024 

E NO 

. B Z<  111). 
).  1 E-N0<  1 


NAME  - -TABLE 


TYPE- -10 

S0URCE--D.  CHESLEY 

PU RPOSE  - - P r in t s the  output  from  C0RRL8  in  a simplified  tabular 
f orm . 

DESCRIP TI0N--CALL  TABLE 


COMMON - - / PR I NT / contains  data  to  be  printed  for  each  channel. 

(1)  (see  below)  is  calculated  from  JMAX(I)  and  JMIN(I) 

/COR/  - contains  sum  trace  and  necessary  start  and  stop  times 
/X/  - contains  length  of  sum  trace  in  data  points 


NOTES--  TABLE  prints  correlation  output  for  each  channel,  which 
includes: 


(1)  start  and  stop  times  for  reference  and  scan, 

(2)  times  of  maximum  and  minimum  correlation  coefficient, 

(3)  values  of  maximum  and  minimum  correlation  coeffi- 

cient, 

(4)  slopes  at  maximum  and  minimum  of  correlation  (rel- 

ative amplitude  of  scan  with  respect  to  reference) 

(5)  standard  error  in  slopes, 

(6)  amplitude  of  scan  signal  in  digital  units  (*=  slope 

x peak-to-peak  amplitude  of  reference). 


(7)  standard  error  of  (6). 

For  the  sum  trace  only  (1),  (2),  and  (3)  are  printed. 
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1 5 N 

oco? 

SUBROUTINE  table 

I sn 

OCO  1 

< DMMl'N/PHINI  / JMAX  ( * > , JM  ! N ( * ) , C^AX  ( A ) ,TMIN(  4)  . SLOPE  1 ( * ) , 

• SLOP!  2 l *4  ) • ERROR  1 ( * ) . ERROR?  < 4 ) . *Mpt  1(4),  AMPL  2(4)  • AMP ER  1 ( * 1 

• AM*T  R?  ( 4 1 

! S N 

00  0 * 

rf<A4MON/rt)R/SUM(  2700),  I RET  1 (5)  • JREFpf  8) » IHRIG(5). 
. T .1  AN1  ( 6 ) • t ST  AN?  ( 5 > 

I Sn 

0 n 

COMMON/ X / 1 KMA  X 

T S N 

ooo*> 

OI  MENS  ION  ANAME(*) 

! SN 

000  7 

integer  hf ad 

I 5 N 

3 0 00 

DIMENSION  HE  AO  ( 5 ) * I T 1 MM  5 ) 

( SN 

nnoo 

DATA  AnAME/'CH  IS'CH  2 * • 'CM  3 * » • SUM  «/ 

1 SN 

0^10 

C A!  1 HOCMNV  ( I 1 ! ME  • 1 ) 

! S N 

00  1 1 

C At  l M02SFC < I T I MF , f T > 

I SN 

00  12 

< Al  1 MA  X MI  N < SUM*  1 X M A X , CM  AX ( * ) . M AX  , CM  lN(  * ) , M I N ) 

t SN 

001  * 

J M A X ( * ) 'MAX*  1 T - 1 

I SN 

00  1 4 

r 

J M 1 N ( 4 ) -MlNM  T - 1 

I SN 

00  1 5 

V 

PRINT  *9 

I SN 

00  16 

*9 

F«)PMAT  ( 1 Ml  ) 

1 SN 

00  17 

PRINT  20,  ( IRCFI  (K)  .K-!  . 5 ) • ( I REF?  ( K ) . K^2 . 5 ) • f ISCANl<K).K=I 
.<  ISC  AN  2 ( K ) , K = ? » 5 ) 

! SN 

oc  1 a 

20 

F ORM A T ( 1 X , • REF  FROM  9 . [ * . * - • * f 3 * * - * • ? ( 1 2 • • I • ) • I 2 • ? X « • T O • 
• 1 3 • • - • *2(  12**  ! • ) » ! 2 ,4  X , ' SC  AN  FROM  9.I4.9-*,13*9-9* 
.?(I2,':M,I2,2X,'TO  MS 9 - 9 . 2 < 1 2 . 9 : 9 ) . I ?• //  ) 

f SN 

00  1 Q 

PRINT  9 

I SN 

0020 

9 

L ORM A T ( 1 X,//*2?X, •**♦*********♦***••//) 

! SN 

002  1 

PRINT  10 

! SN 

0 0 ? 2 

t 0 

FORM  A T ( 1 X , • CHANNFl  * ,10X,'  TIME'  .fl*.’ CORR  COEF  9 . 5X . 'SLOPE', 
. 4X  . • LOG  St  OPF  9 ,5X«  'ERROR*  . 9X  * • AMPL  I TURF  • , JlX  , • AMP  ERROR  • I 

! SN 

0023 

PRI NT  11 

I SN 

002* 

1 1 

FORM  AT ( 1 X , // , 20 X • • 0 A T A FOP  maximum9*/) 

l SN 

0025 

c 

OO  100  J=l • 3 

r sn 

0026 

FAI  ( SEC?HU(  JMAXf  J)  'HEAP > 

I SN 

002  7 

1 F ( SLfipe  1 ( J ) . EQ  • 0 • ) SL  ope  = 0 • 

I SN 

0020 

IF  ( SLOPE  1 < J ) . NF  .0  . ) SLOI'E  - ALOG1  0 ( A8S  C SL  OPE  1 ( J > ) ) 

I SN 

00  31 

PRINT  l 2 , AN  A ME  ( J ) , ( HE  ACM  K ) • K=  l .5  ) ,CMAX(  J ) , 

• SLOPE l ( J ) .SLOPE*  ERROR l ( J ) * AMPL 1 ( J ) . AM Pfo  1 < J 1 

l SN 

0012 

1 2 

h ORM A T ( 1X.A4,6X.IA.9-9*I3*,-'*2<  I £*•:•)  * I2,lX*F7.4,3X.Fl 

*?X  .F  8*5*  IX, F 9*6*  4X,F  I 1 .2.3X.F9.?./) 

T SN 

0033 

C l 00 

font  I nue 

I SN 

001* 

CALL  SEC2HD(  JMAXt  * 1 ,MEAO > 

r sn 

0035 

PRINT  14,ANAM£\>  t,(HgADU  )*K=l*6)*CMAX(A) 

t SN 

00  16 

1 * 

c 

FORMAT  IU,A4.6X,I4  *r  3.'-'  ,?(  12*  ' M?*  3X.F7.4,  1X.1  J 

• 2x  , 8(  ' ♦ * ) * 3 * . 9<  • ♦ 9 ) « 4 X « 1 1(  94-9  ) * 3 x * 9 ( 9 ♦ 9 ) • / ) 

f SN 

00  17 

PRINT  13 

! SN 

0038 

1 3 

FORM  AT  ( l X . / * 20X * 9 DAT  A FOR  MINIMUM9,/) 

1 SN 

0 0 39 

OO  200  J=! .3 

I SN 

00*0 

fail  SFC2HIM  JMI  N(  J ) .ME  Al)  ) 

1 SN 

00*1 

I F ( SL OPE  2 f J).FO.O.)  SL  OPE=0. 

f SN 

0043 

T F ( SLOPE  2 ( 1 > . NF  , 0 • ) SI  «>PE  = Al  OGl  0 ( AOS  < Si  (1PF2<  J ) > ) 

t SN 

00*5 

PRINT  12,  ANA  MF  ( J)  , (HE  aOOO  ,X-I  ,5)  »CMlN(  J ) , SLOPE  2 < J ) • 

.SL  OPF  , F RMOR2  UK  AMPl  2 ( J ) . AMOT  R 2 ( J ) 

! SN 

00*6 

C200 

C ON  T I NUE 

1 sn 

004  7 

CALL  SEC  2HD  ( JM  IN(  4 ) , Mr  Af)  ) 

1 SN 

0r  *0 

c 

PRI  NT  14*  AN  AME  ( 4 | . ( HE  AO  < 1C  ) * K - 1 • 5 * • CM  f N i 4 > 

1 SN 

00*9 

V. 

PRINT  9 

r sn 

ooso 

RETURN 

I SN 

0051 

End 

s l . 


.61 


• ♦ • ) 


r 


"'Him  MIL  liliuuiiaMMHI*MM 
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NAME --WRTSUM 
TYPE--IO 

. OURCE - - D . CHESLEY 


PU RPOSE - -wr 1 t e 8 the  sum  trace  of  one  station  permanently  on  disk 
after  several  component  correlations  have  been  performed. 
This  trace  Is  used  for  beam  focusing. 

DESCRIPTION -CALL  WRTSUM  (IF) 

IF  - Device  or  file  name  In  JCL  that  describes  the  output 
file. 

COMMON -- /SMACK/  contains  the  start  time  and  station  number 
/X/  contains  the  length  of  the  sum  trace 
/COR/  contains  the  siim  trace 


NOTES:  User 

program . 


must  supply  the  appropriate  JCL  with  the  main 
Refer  to  sample  program  CORR  for  details. 


I SN 

0002 

SUBROUTINE  WRTSUM!  1 F » 

I SN 

0003 

COM MON/ SMACK/ A!  (555),A2(555).A3!6S5>.B1<  111). 
,B2< 1 1 1 ) .B3( 111  I .HEAD!  1 0 1 . IREC 

I SN 

0 0 0 A 

C OHMON/X/ TXMAX 

1 SN 

0005 

COMMON /COR/ SUM! 2 70  0 ) . I REF  1 ! 5 ) . I REF2I5 1 a I OR  I G( 9 1 
. I SCAN2  15) 

I SN 

0006 

DIMENSION  I T | ( 5 ) . I E AD ( 1 0 ) 

I SN 

0007 

EQUIVALENCE  ( HE  AO t 1 ) , I E AD ! 1 » ) 

I SN 

ooce 

CALL  HDCONV I I T 1 , 1 > 

1 SN 

0009 

call  Hoasec  (in.iri 

1 SN 

001  0 

WRITE!  IF)  I T , I XMAX.  ICAD(2 ) . SUM 

I SN 

ooii 

ENDF ILE  IF 

1 SN 

001  2 

RETURN 

I SN 

001  3 

ENQ 

I SC  AN  1 ( 5) 
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SAMPLE  PROGRAMS  AND  JCL 

The  final  section  of  this  report  presents  three  sample 
programs  to  show  how  the  subroutines  are  used.  The  FORTRAN 
Is  simple  and  will  not  be  discussed.  Here  we  will  try  only  to 
point  out  some  important  JCL  considerations. 

The  first  program  (QUAKE)  shows  how  the  user  reads  duta 
from  the  tape,  plots  the  data,  and  rotates,  filters,  and  plots 
the  results.  Note  the  order  of  the  PLT1  call  state nients.  The 
final  CALL  PLOT  statement  is  necessary  for  all  programs  that 
create  an  output  tape  for  the  XYNET1CS  plotter.  The  first 
data  set  (B.B2823. BERG 2823)  contains  the  subroutines  described 
in  tills  report;  the  second  contains  the  plotting  routines  that 
run  the  XYNETICS  plotter  (contact  KARL  H1NCK,  HIG,  for  details). 
The  INTAPE  DD  statement  describes  the  input  tape  with  the  data. 
Any  name  may  be  substltuded  for  'INPUT'  but  the  remainder  of 
the  statement  must  remain  as  printed.  The  PLOTTAPE  DD  statement 
describes  the  output  tape.  X10740  and  the  file  number  are  the 
only  characters  that  may  be  changed.  The  file  number  must  be 
2 or  larger . 


»i 
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//OUAKE  JOB  < 2023. 90S, 250K».3KI ) .CHESLEY 
//  ExEC  FORT  CL  G .REGION. 6 O=250K 

//sysin  nr  • 

CQMMON/SE ARCH/CMl  ( 5 55  0 > .CH2C5550 ) . CH3<  6550 ) 

COMMON/ TUP N/CHR(  5550 ) ,CHT( 5550  > 

DIMENSION  I STAR  r (5 ) . I STOP(  5) 

DATA  I ST  A^T/ 1 073  .2 76*1  0*40*00/*  I STOP/ 1973*276.11  *15*00/ 
CALL  setxyn 
SC  ALE  - 1 .5 
HYT  =1 .97 
Wi =20 0 

BPFREQx 1 . /20  . 

CALL  IPF ILT  ( W *N1  .1  . .BPFRf Q ) 

CALL  MAMING(W#nL ) 

CALL  FL T AD J< Nl  . I ST  ART  * I STOP ) 

CALL  F I NO < I ST  ART  , I STOP ) 

CALL  DSPYK  <0  > 

I L A B =0 

CALL  PI  T1(CH3.SCALE*HYT,0.*0.*  •A3,*0*ILA8> 

CALL  PI  T1  < CH2 .SCALE .HYT  *0 . #0 . # • A2*  . 0 . 1L AB) 

C At  L PI  T 1 (CHI  , SC  ALE . HYT  ,0 . .0 . , • Al  * .0  . ILA0  > 

PHI =37. 2 
G A= 1 • l ZX  0 

CALL  ROT  ATE ( PHI  . GA ,0 ) 

CALL  doftlticht, W.Nl ,0 } 

CALL  DOF  I t.T  ( CHR.  W.  M . 0 ) 

CALL  DOF  I LT < CHI  . W . N1  . 1 ) 

I L A8=3 

CALL  Pi  Ti (CHT.SCALE.HYT.O. .0 . . • AT • .0 • IL  A0  ) 

CALL  PI  T 1 ( C HR, SCALE . HYT • 0 • • 0 • . • AR • . 0 . I L A B ) 

I L A B = 2 

CALL  I’LTl  ( CHI  .SCALE,HYT*0  . .0  .*  • Al  • ,0  . ILAB> 

CALL  PLOT < 0 . .HYT . 999 ) 

STOP 

END 

//LOAP. S YSL I B OD  OS N = 0 • B 2 8 2 3 • BERG2 02 3 • D I SP= SNR 
//  UD  DSN=T22 5660. XYNLI0.LOAD.OI SP=SHR 

//  OD  DSN-SV51  .F ORTL  I 0. DI SP  = SHR 

//GO.  INTAPE  DD  VOL=SER=I  NPUY .UNI T = 7TRK . DI SP  = OLD .LABEL  = ( .NL)  • 
//  DC0=( 0LKS T ZE=7000.RECFM=U. DEN=1 ) 

//GO. PLOT  F APt  DO  UNIT=(DTRK  . .DE.FER)  .VOL=SER=X10740  .DISP  = OLD. 
//  LABEL = ( 1 5 *NL ) . OCB=OEN=2 
//GO. SYSIN  DO  A 
// 


CORR  shows  how  a correlation  Is  accomplished.  In  this  case 
a high-pass  (in  frequency)  filter  with  401  data  points  and  a 
cutoff  at  45  sec  is  applied  to  the  data  inside  COREAD.  A 
rotation  is  done  inside  COREAD  (THETA  and  G are  non-zero). 

Two  channels  are  correlated  and  the  sum  trace  is  written  in  a 
permanent  file. 

The  BLOCK  DATA  subprogram  contains  the  times  required  by 
COREAD  for  tape  reading.  Fill,  FT12,  and  FT13  describe  the 
scratch  files  where  COREAD  places  the  tape  data.  These  files 
are  destroyed  at  the  terminus  of  the  job.  FT15  describes 
the  permanent  file,  which  coni  'ns  the  sum  trace  for  later  beam 
focusing.  If  the  program  terminates  abnormally,  step  B elemi- 
nates  this  file  from  the  disk  and  catalog. 
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//CJRR  JOB  < 282 3. 295kR. 3K I . 200S) . CHE SL EC 
//  EXPC  FORTCLG.RLGl  ON. LOAD - l l 0 K • R E G l ON  .GO*  29  Sk 
//SYSIN  00  * 

C C'MMON/COR/ SUM  (2700).  IrEF 1 < S).  IREF2<St,lORlC(6». 

. 1 SCAN! < 5 ) . 1SCAN2  <5  > 

CCMMON/ARR  AY/N  ,W(  l 0 00  ) 

C ALL  SET  X VN 

scale  = 1.5 
M V J = 1 . 97 
HPFREO = 1 ./50 . 

N =200 

THE  T A - 24 . 5 
G - 1 . 

CALL  MPF I LT ( W . N.l  . .HPFREO) 

C ALL  HAM  1 NG(  W, N I 
1 L - 1 

CALL  COREAD( IL . THE TA ,G ) 

L AB  = 3 
NL'MCH  -2 
N F I L E s J 5 

C ALL  C.ORRL  8(2.  SCALE.HYT.LAB.NUMCH.NFUE) 

C Ail  CORK  1.8  < 1 .SCALE.HYT.LAB.NtlMCH.NF  IL  £ I 
CALL  TABLE 

c 

Call  Rl  r i < Sum , sc  ale.hyt i . . ■ Sm • , o. o ) 

Call  Plot < o . .h YT .999 ) 

S TOP 
End 

BLOCK  DATA 

COMMON /CO R/SUm<  2700  ) » I REF  1 (5  )•  I RE  F 2 < 5 ) . IORIG<5> • 

. ISCAN1  ( 5 ) . ISCAN2 ( 5 ) 

data  1REF1/J97  3.276.1  0.40.00/.  I REF 2/ I 97 3 . 2 76 . 1 0.54. 0 0/ 

DATA  I DR  I G/  19 7 3. 276, 1 0 .25. 00 / 

DATA  I SC  A Nl/1 9 73. 276.  11. 40. 00/.  ISCAN2/19  73.276 .12.10.00/ 

E ND 

//LOAD.  SYSL  I B DD  DS  N =8  .B  2 82  3 . BE  RG  2 82  3 . DI  SP  =S  HR 
//  DD  OSN=Y 22 5660 .XY NL I B.LOAD. DlSP=SHft 

//  DD  DSN=SYS1  *F  ORTL I 8, D1  S P = S HR 

//  DD  DSN)  =SY S 1 .FORTSUB  , OI  SP  = SHR 

//LOAD.  SYS  1 N DO  * 

//GO • I N TAPE  DD  VOL -SER- I NPUT  .UN  I T= 7TR*.D I SP-OLD ,LA8EL=< 7n NL)  . 

//  PC  B = < 8LK3  I 7E  =7000 . RECFM=U , DE  N -- 1 ) 

//GO.  PL  OTT  APE  DD  VOL  =SEft  = Ml  0 74 0 . ON  I T = D ’ P K . DC B = D£N  = 2. DlSP  = OLD, 

//  l ABE  L"  ( 2 5.  NL  ) 

//FT  1 1 F 001  DD  UM  I T = s YSOA  , DCB= ( RECFm-VS .LRECL  = 2 2 20  4.BLKS1 7E*  72  94. 

//  BUFNO  = l ) . SPACE  = < TRK • ( 2 .1  ) ) 

//FT l >P 001  DD  UN  1 T = S YSOA  .DC  B= ( RTCF  m=  VS .LRFCL  =22 20  4, BLKS IZE  = 72  94 . 

//  6UFnO=1  ) .SPACE  = < T PK  . ( 2 . 1 ) ) 

//F  r 1 Oh  001  DD  UNI  T =s  YSDA  .DC  B=  (PECFM  = V'S  .LRFCL  =2  2204  . BLKS l ZE*729  4 . 

//  0UFM O =1  ) • SPACE1 IT  RK . ( 2.1  ) ) 

//FT  1 5f  001  DD  UN1I  =USERD  A . D1  SP-  ( , C AT  LG.  DEL  ET  E > . OS N= B .6 2823 . TLOC&  830. 
//  DCB  - (RECFM--VS.  LRFCL=2  221  6.BLKSI  ZE=72  94  . BUFNO=l  1 ,9PACE=(  TRK.  < 2.  1 I » 
/ / FT  1 6 F 00  1 DD  UN  IT  = U SERD  A . O 1 SP  = < , C AT  LG  .DElF T E ) ,DSN=B  .B2823.  ll.OC  1830. 
//  DC  B --  (RECFM  --VS  .LRFCL  =2  221  6 • BLKS  I ZE  = 729  4 . BU  FN  0=  J I ,SPACE=  ( TRK.  ( 2.  II  ) 
//GO. SYSIN  DD  * 

//B  EXEC  PC.M=  I EHPROGM.COND=  ONLY 
//SYSPftINT  00  SYSOUT=A 
//SYS  IN  DD  » 

UNCATLG  OS  NAME  = 8 . B2  823  . T LOCR830 

UNCATLG  DSN  Am  E = FT  .82  823  . T LOCI  83  0 
// 


.*>nn  nnn 


SHMAVE  shows  how  the  permanent  flle9  created  by  several 


runnings  of  CORR  may  be  added  for  a beam  focusing  effect.  This 
program  averages  the  part  of  each  sum  trace  which  is  in  common 
with  the  other  sum  traces,  plotting  the  original  and  the  averag- 
ed s um  traces  . 


//SUMAVE  JOP  ( 2823 .40S .295KR . 3KI >. CUE SL EY 
//  ExEC  PtlRTCt  G .REG!  ON.GO- 2 <?5K 

//SYStN  I'D  » 

C OMMON/X/I  XM AX 

COMMON/5MACK/AK  55  5)  . A2<  55  5)  . A3I555  > .01  ( 1 I 1 ) . 

.82(111), 83(111  ) . HE  ADI  10),  T REC 

01  MENS! ON  IEAD(tO),XSUM(2700.10).txC<lO),ITrME(10l . ASUM( 2 700 1 . 
. ! ME  ADI  5 ) . JHE AD( 5 ) . I ON( 1 0 ) , I OFF ( 1 O ) 

EQUIVALENCE  ( HEAOI 1 > . 1 F AD( 1 ) 1 

call  setxyn 

I 8EG=-1E*1 Q 
I END- - I BEG 
SCALE-1 . 5 
HYT -1 . 97 
I PL.  T = 1 
NUMSUM=4 
[ 8 -0 

IDEV=10+  NUM5UM 
DO  100  I =1 1 , I OEV 

IBslB+1 

REAIM  I I I T 1 ME  ( IB  ) . I XC  ( I B ) . IE  AD  (2  ) . A SUM 
I F ( I PLT-1 (00.50.80 
50  CALI  SEC2HDI  IT  IMF.  ( IR  1 , I HEAD1 
CALL  HOCONV  ( I HF AO,  -1  ) 

I x M A X — I XC  ( IB  1 

CALL  PL  T1  ( ASUM.SC ALE . HYT,1.,-1..,SM*,0.0> 

80  J2  = I XC< 18 ) 

on  90  J = I . J? 

90  XSUM( J, I B) =ASUM( J ) 

100  CONTINUE 

calculate  start  ano  stop  times 

DO  200  1=1, NUMSUM 

I BE  G = MAX0 ( I BEG , I T I ME(  I ) ) 

I S = I T I ME  ( I ) MXCI  I >-t 
I ENO=MINO(  I E ND .IS) 

200  CONTINUE 

CALC.  OFFSETS  FOR  EACH  TRACE 

DO  300  I-| .NUMSUM 

I ONI  I > = I 0EG-! T IMEI  I 1 ♦ 1 
I OFF  I I > = I END- I BE  fa  ION ( I ) 

300  CONTINUE 

DO  325  K = 1 ,2700 
325  ASUMI K ( =0 . 

AVERAGE  THE  SUMS 

00  400  1=1. NUMSUM 

K =0 

J 1 = I ON  I I ) 

J2  = I OFF  I I ) 

341  CONTINUE 

00  350  J = J!  . J2 
X = K ♦ 1 

ASUMI  K ) -ASIIMI  K ) ♦ X5UMI  J,  I ) 

350  CONTINUE 


I 


?» 


- V.-  T 'A** 


♦ 00  CUN  T [ NUE 

no  450  J-! ,K 

450  ASUMI  J)  -ASUM(  J > /NUMSIJM 

c 

C PI  l)T  the  AVERAGE' 

C 

I X M A X = K 

CAIL  SEC  2 HO  < I BEG  . T HEAD* 

CALC  HCCONVI IHEAOt-J ) 

I E *D( 2 ) =0 

CALL  PL  T 1 ( ASUM .SCALE .HVT , +1 . .-I . , • AV • .0.0) 

C 

C PRINT  RESULTS 

C 

CALL  MAX  M I N ( ASUM , IXMAX.SMAX.JMAX.SMIN.JMIN) 

JMAX’JMAX ♦ IBEG-1 
JMI N- JMI N ♦ I BEG-1 
CALL  SCC2HIR  JNAX . THFAD) 

CALL  SEC  2 HD  ( JMlN.JHFAf)* 

PRINT  40  2 . I I HEAD! K > ,K =1  .5 » . SM AX 
PRINT  403. ( JHEAOIK ) ,K=I .5) . SM I N 
A 0 2 FORM  ATI J x , • T [ ME  OF  max:  • . 14 . • . 13 ,2X , I 2 , • : • , I 2,  • : • , I 2,  • 

. . • oeff : '.F6.J.//I 

♦ 03  FORM  at  I 1 X . • T I ME  OF  min:  • . I 4 . • - • . I 3 . ZX . I 2 . • ! • . I 2 . • : • , I 2 . • 

. . * OEFF : • .F6.3.//I 

CALL  PLOT  I 0 . . HYT . 099 > 

STOP 
E NO 

//l  OAD.STSLIB  DO  ns N=B . B2 B2 3 . BER G2 8 2 3 . D I SP = SHR 
//  on  OSN-T225660 . X YNL I n.L OAn. O I SP =SHR 

//  no  osn-sysi .fortli n.oi sp=shr 

//  no  0SN=SYS1 .FORTSUB.OI SP=SHR 

//loao.sysin  no  • 

/ /GO. PLOT  TAPE  DO  VOL=SER  = X51 698 . UN ! T =D TRK  . OCB=OEN  = 2 ,D I SP  = OLD. 

//  LABEL  = I I 1 . NL I 

//FTMFCOl  no  OS  N-B.B2823  .K  I PF  . D ISP-OL  D 
/ /F  T 1 2F  CO  1 no  DSN  = B .n  282  T .MATE . O I SP  = OLD 
//FT13F001  DO  DSU  = 0 .02  82  3 . TLQFR  .'0  I SP=PL  n 
//FT14F001  OO  OSN=B .P2023 .CHGf .n I^n-OLD 
//GO.SYSIM  OD  * 

// 


98 


FILTERl  illustrates  the  use  of  1NFILT  to  retrieve  the 
ground  motion  by  deconvolving  the  instrument  response  from 
the  tape  data.  This  program  calculates  and  plots  a 'filter' 
for  each  channel.  It  reads  the  tape  and  applies  these  'filters' 
and  then  plots  the  ground  motion.  Finally,  FILTER1  filters 
the  data  with  a high-pass  filter  and  plots  the  results.  The  data 
set  B . B 2 82 3 . I NRES P contains  the  Fourier  coefficients  of  the 


instrument  response  for  each  of  the  three  channels. 


99 


//fltltRl  JUO  (2823,26  05  » 29bKRi  I I.CHESLEy 
//  EXEC  FORTCLG  ,REGl  ON.  GO  -2  VbtC 
//sysin  DD  * 

C Ommon/SM  ACK/A1(S5S>.A2<5S5>.A3<5S5).01<  111  ), 

. fi2<  111)  , Ft  3 ( l I 1 I .HE  Ap<  J 0 ),  IR  EC 
COMMON /SEARCH/ CHI  ( SS5  0 ) .CH2  ( 5660)  . CH  3(  6 6 50) 

C CJMMON/X/  I X M AX 

DIMENSION  1 ST  ART  < 5 > .1ST  OP  < 5 ) . »< 1000  > 

DIMENSION  W 1 ( SI  3 > , * 2<  Sl3».Wi(E13) 

DATA  I S 1 ART / 1 9 73 .2 76. I 0 , AO.  00/ . I S T OP/ 1 9 7 3 .2 76 . 1 1 . 20 . 00 / 
CAUL  StrxYN 
S CAL  E = 1 .5 
H V T =t  .97 
N =256 
N 1 = 400 
NSUM=  N+Nl 

CALL  FLTADJ  (N9UM.  I START  . ISTOPI 
HPFR£Q  = 1 ./100  . 

CALL  HPF ILT (W.Nl .1 . .HPFREQ1 
CALL  H4MI N6 ( W . N1 ) 

I LA 8*0 
I XMAX  =513 

CALL  I NF  I L T < 1 . W1  ,N  , 1 . 1 4 ) 

CALL  INF  ILT  ( 2.  W2.  N . 1 . 14  ) 

CALL  ( NF l LT <3  . W3 .* .1  , M > 

C ALL  PL  T 1 ( W3. SCALE ,HYT,0.,0.  . • F3*  ,0.1 LABI 
C ALL  PLT  1 ( W2.S  CALE  , HVT  . 0 . . 0 . . 'F21 . 0 . IL  A0  ) 

CALL  PL  T l <41  , SCALE, HYT.O.  .0  . . • FI • .0.  ILAB  > 

CALL  F IND(  1 START  , I STOP  I 
C ALL  DSPYK  <0  I 
CALL  DOF  I L T < CH 3 ,W3 . N.O I 
CALL  DOF  1 1.  T < CH2.W  2 ,N,  0 ) 

CALL  DOF  I LT  ( CHI  ,W I , N, l ) 

C ALL  PL  T1  (Cm3,  SCALE  » H Y T ,0,  ,0  .,  • G 3 • ,0 . 1 1. A0> 

C ALL  PL  T 1 (CH2. SCAlE.HYT ,0 ., 0 .,  • G2*  .O.ILAB) 

C ALL  Pl.  T 1 (CHI  .SCALE  ,HYT  ,0.,0  ..  *61  • .O.ILAB) 

call  DOFIl  T (CH3.W.NI  ,0) 

C A | L DOFfLT  (CH2.Y.N1 ,0  I 
CALL  OOF  IL  T ( CH  1 . w . N1  , 1 ) 

C ALL  PLT1(CH3, SCALE. HYT.O..O..  * G 3 ' « 0 . 2 > 

CALL  PL T 1 (C H2. SCALE. MY T.0.,0.. • G2 • . 0 . 2 > 

C ALL  PL  T 1 (CHI  .SCALE.HYT.C..0..  'Gl*  .0.21 
C A!  L PLOT  <0  . .HYT  ,900) 

S TOP 
e no 

//LOAD.  SYSl  I e 00  DSN=e  .3282  3.  ttE  PG  2fl2  3 • D l SP=SHP 

//  DO  DS  N =T  22  566  0 . X Y M I B.  L CAD  . D I SP  = S HP 

//  DO  DSN=SYS1 .F ORTL I B . 01 SP=SHR 

//  OD  OSN=SYS  1 .FORTSUB  , 0 I 5P=SHJ? 

//LOAD.  SYS  I N OD  * 

//GO. INTAPE  no  UNIT  = 7TRK,V0L  = SER-X51045.Dt  SP-OLO, 

//  DCF)  = <RECFM=U.  PLUS  I ZE=  7000. DEN  = 1 ) ,LA8EL=(  .NL  ) 

/ /G O.  PL  OT1 APE  on  VOL  =SER  = X51 6 98 .D 1 SP  = CH  D . OCB=  0 EN=  2.0  NI  T =0T  Rk  . 
//  LAEEL=(22.NL) 

//GO.  FT  14F00  1 OD  DSN=B  .62823  . INRESP,  O ISP  = SHR. 

//GO.  Sv  SI N DO  * 

// 


